From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/hipe/icode/Makefile | 144 ++ lib/hipe/icode/hipe_beam_to_icode.erl | 2326 +++++++++++++++++++++ lib/hipe/icode/hipe_icode.erl | 1820 ++++++++++++++++ lib/hipe/icode/hipe_icode.hrl | 188 ++ lib/hipe/icode/hipe_icode_bincomp.erl | 178 ++ lib/hipe/icode/hipe_icode_callgraph.erl | 217 ++ lib/hipe/icode/hipe_icode_cfg.erl | 203 ++ lib/hipe/icode/hipe_icode_coordinator.erl | 274 +++ lib/hipe/icode/hipe_icode_ebb.erl | 30 + lib/hipe/icode/hipe_icode_exceptions.erl | 474 +++++ lib/hipe/icode/hipe_icode_fp.erl | 1043 +++++++++ lib/hipe/icode/hipe_icode_heap_test.erl | 200 ++ lib/hipe/icode/hipe_icode_inline_bifs.erl | 240 +++ lib/hipe/icode/hipe_icode_instruction_counter.erl | 135 ++ lib/hipe/icode/hipe_icode_liveness.erl | 101 + lib/hipe/icode/hipe_icode_mulret.erl | 1323 ++++++++++++ lib/hipe/icode/hipe_icode_pp.erl | 303 +++ lib/hipe/icode/hipe_icode_primops.erl | 963 +++++++++ lib/hipe/icode/hipe_icode_primops.hrl | 40 + lib/hipe/icode/hipe_icode_range.erl | 1966 +++++++++++++++++ lib/hipe/icode/hipe_icode_split_arith.erl | 553 +++++ lib/hipe/icode/hipe_icode_ssa.erl | 98 + lib/hipe/icode/hipe_icode_ssa_const_prop.erl | 728 +++++++ lib/hipe/icode/hipe_icode_ssa_copy_prop.erl | 41 + lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl | 1444 +++++++++++++ lib/hipe/icode/hipe_icode_type.erl | 2266 ++++++++++++++++++++ lib/hipe/icode/hipe_icode_type.hrl | 25 + 27 files changed, 17323 insertions(+) create mode 100644 lib/hipe/icode/Makefile create mode 100644 lib/hipe/icode/hipe_beam_to_icode.erl create mode 100644 lib/hipe/icode/hipe_icode.erl create mode 100644 lib/hipe/icode/hipe_icode.hrl create mode 100644 lib/hipe/icode/hipe_icode_bincomp.erl create mode 100644 lib/hipe/icode/hipe_icode_callgraph.erl create mode 100644 lib/hipe/icode/hipe_icode_cfg.erl create mode 100644 lib/hipe/icode/hipe_icode_coordinator.erl create mode 100644 lib/hipe/icode/hipe_icode_ebb.erl create mode 100644 lib/hipe/icode/hipe_icode_exceptions.erl create mode 100644 lib/hipe/icode/hipe_icode_fp.erl create mode 100644 lib/hipe/icode/hipe_icode_heap_test.erl create mode 100644 lib/hipe/icode/hipe_icode_inline_bifs.erl create mode 100644 lib/hipe/icode/hipe_icode_instruction_counter.erl create mode 100644 lib/hipe/icode/hipe_icode_liveness.erl create mode 100644 lib/hipe/icode/hipe_icode_mulret.erl create mode 100755 lib/hipe/icode/hipe_icode_pp.erl create mode 100644 lib/hipe/icode/hipe_icode_primops.erl create mode 100644 lib/hipe/icode/hipe_icode_primops.hrl create mode 100644 lib/hipe/icode/hipe_icode_range.erl create mode 100644 lib/hipe/icode/hipe_icode_split_arith.erl create mode 100755 lib/hipe/icode/hipe_icode_ssa.erl create mode 100644 lib/hipe/icode/hipe_icode_ssa_const_prop.erl create mode 100644 lib/hipe/icode/hipe_icode_ssa_copy_prop.erl create mode 100644 lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl create mode 100644 lib/hipe/icode/hipe_icode_type.erl create mode 100644 lib/hipe/icode/hipe_icode_type.hrl (limited to 'lib/hipe/icode') diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile new file mode 100644 index 0000000000..de37c4e4c4 --- /dev/null +++ b/lib/hipe/icode/Makefile @@ -0,0 +1,144 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-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% +# + +ifndef EBIN +EBIN = ../ebin +endif + +ifndef DOCS +DOCS = ../doc +endif + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(HIPE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +ifdef HIPE_ENABLED +HIPE_MODULES = hipe_icode_heap_test +else +HIPE_MODULES = +endif + +DOC_MODULES = hipe_beam_to_icode \ + hipe_icode hipe_icode_bincomp \ + hipe_icode_callgraph hipe_icode_cfg hipe_icode_coordinator \ + hipe_icode_fp \ + hipe_icode_exceptions \ + hipe_icode_inline_bifs hipe_icode_instruction_counter \ + hipe_icode_liveness \ + hipe_icode_pp hipe_icode_primops \ + hipe_icode_range \ + hipe_icode_split_arith \ + hipe_icode_ssa hipe_icode_ssa_const_prop \ + hipe_icode_ssa_copy_prop hipe_icode_ssa_struct_reuse \ + hipe_icode_type $(HIPE_MODULES) + +MODULES = $(DOC_MODULES) hipe_icode_ebb hipe_icode_mulret + +HRL_FILES=hipe_icode.hrl hipe_icode_primops.hrl hipe_icode_type.hrl +ERL_FILES= $(MODULES:%=%.erl) +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +DOC_FILES= $(DOC_MODULES:%=$(DOCS)/%.html) + +# APP_FILE= +# APP_SRC= $(APP_FILE).src +# APP_TARGET= $(EBIN)/$(APP_FILE) +# +# APPUP_FILE= +# APPUP_SRC= $(APPUP_FILE).src +# APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +include ../native.mk + +ERL_COMPILE_FLAGS += +warn_unused_import +warn_missing_spec +warn_untyped_record + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +docs: $(DOC_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + +$(DOCS)/%.html:%.erl + erl -noshell -run edoc_run file '"$<"' '[{dir, "$(DOCS)"}]' -s init stop + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/icode + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/icode + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + +$(EBIN)/hipe_beam_to_icode.beam: hipe_icode_primops.hrl ../main/hipe.hrl ../../compiler/src/beam_disasm.hrl +$(EBIN)/hipe_icode.beam: ../main/hipe.hrl +$(EBIN)/hipe_icode_bincomp.beam: ../flow/cfg.hrl +$(EBIN)/hipe_icode_callgraph.beam: hipe_icode_primops.hrl +$(EBIN)/hipe_icode_cfg.beam: ../flow/hipe_bb.hrl ../flow/cfg.hrl ../flow/cfg.inc ../main/hipe.hrl +$(EBIN)/hipe_icode_ebb.beam: ../flow/cfg.hrl ../flow/ebb.inc +$(EBIN)/hipe_icode_exceptions.beam: ../flow/cfg.hrl +$(EBIN)/hipe_icode_fp.beam: ../flow/cfg.hrl +$(EBIN)/hipe_icode_heap_test.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl ../rtl/hipe_literals.hrl +$(EBIN)/hipe_icode_inline_bifs.beam: ../flow/cfg.hrl +$(EBIN)/hipe_icode_instruction_counter.beam: ../main/hipe.hrl ../flow/cfg.hrl +$(EBIN)/hipe_icode_liveness.beam: ../flow/cfg.hrl ../flow/liveness.inc +$(EBIN)/hipe_icode_mulret.beam: ../main/hipe.hrl hipe_icode_primops.hrl +$(EBIN)/hipe_icode_primops.beam: hipe_icode_primops.hrl +$(EBIN)/hipe_icode_range.beam: ../main/hipe.hrl ../flow/cfg.hrl hipe_icode_primops.hrl +$(EBIN)/hipe_icode_split_arith.beam: ../main/hipe.hrl hipe_icode.hrl ../flow/cfg.hrl +$(EBIN)/hipe_icode_ssa.beam: ../main/hipe.hrl ../ssa/hipe_ssa.inc ../ssa/hipe_ssa_liveness.inc +$(EBIN)/hipe_icode_ssa_const_prop.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl ../ssa/hipe_ssa_const_prop.inc +$(EBIN)/hipe_icode_ssa_copy_prop.beam: ../flow/cfg.hrl ../ssa/hipe_ssa_copy_prop.inc +$(EBIN)/hipe_icode_type.beam: hipe_icode_primops.hrl ../flow/cfg.hrl hipe_icode_type.hrl +$(EBIN)/hipe_icode_ssa_struct_reuse.beam: ../main/hipe.hrl hipe_icode_primops.hrl ../flow/cfg.hrl + +$(TARGET_FILES): hipe_icode.hrl ../misc/hipe_consttab.hrl diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl new file mode 100644 index 0000000000..3923e98673 --- /dev/null +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -0,0 +1,2326 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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_beam_to_icode.erl +%% Author : Kostis Sagonas +%% Description : Translates symbolic BEAM code to Icode +%%======================================================================= +%% $Id$ +%%======================================================================= +%% @doc +%% This file translates symbolic BEAM code to Icode which is HiPE's +%% intermediate code representation. Either the code of an entire +%% module, or the code of a specified function can be translated. +%% @end +%%======================================================================= + +-module(hipe_beam_to_icode). + +-export([module/2, mfa/3]). + +%%----------------------------------------------------------------------- + +%% Uncomment the following lines to turn on debugging for this module +%% or comment them to it turn off. Debug-level 6 inserts a print in +%% each compiled function. +%% +%%-ifndef(DEBUG). +%%-define(DEBUG,6). +%%-endif. + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). +-include("../../compiler/src/beam_disasm.hrl"). + +-define(no_debug_msg(Str,Xs),ok). +%%-define(no_debug_msg(Str,Xs),msg(Str,Xs)). + +-define(mk_debugcode(MFA, Env, Code), + case MFA of + {io,_,_} -> + %% We do not want to loop infinitely if we are compiling + %% the module io. + {Code,Env}; + {M,F,A} -> + MFAVar = mk_var(new), + StringVar = mk_var(new), + Ignore = mk_var(new), + MkMfa = hipe_icode:mk_move(MFAVar,hipe_icode:mk_const([MFA])), + MkString = hipe_icode:mk_move(StringVar, + hipe_icode:mk_const( + atom_to_list(M) ++ ":" ++ atom_to_list(F) ++"/"++ integer_to_list(A) ++ + " Native enter fun ~w\n")), + Call = + hipe_icode:mk_call([Ignore],io,format,[StringVar,MFAVar],remote), + {[MkMfa,MkString,Call | Code], Env} + end). + +%%----------------------------------------------------------------------- +%% Exported types +%%----------------------------------------------------------------------- + +-type hipe_beam_to_icode_ret() :: [{mfa(),#icode{}}]. + + +%%----------------------------------------------------------------------- +%% Internal data structures +%%----------------------------------------------------------------------- + +-record(beam_const, {value :: simple_const()}). % defined in hipe_icode.hrl + +-record(closure_info, {mfa :: mfa(), arity :: arity(), fv_arity :: arity()}). + +-record(environment, {mfa :: mfa(), entry :: non_neg_integer()}). + + +%%----------------------------------------------------------------------- +%% @doc +%% Translates the code of a whole module into Icode. +%% Returns a tuple whose first argument is a list of {{M,F,A}, ICode} +%% pairs, and its second argument is the list of HiPE compiler options. +%% @end +%%----------------------------------------------------------------------- + +-spec module([#function{}], comp_options()) -> hipe_beam_to_icode_ret(). + +module(BeamFuns, Options) -> + BeamCode0 = [beam_disasm:function__code(F) || F <- BeamFuns], + {ModCode, ClosureInfo} = preprocess_code(BeamCode0), + pp_beam(ModCode, Options), + [trans_beam_function_chunk(FunCode, ClosureInfo) || FunCode <- ModCode]. + +trans_beam_function_chunk(FunBeamCode, ClosureInfo) -> + {M,F,A} = MFA = find_mfa(FunBeamCode), + Icode = trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo), + {MFA,Icode}. + +%%----------------------------------------------------------------------- +%% @doc +%% Translates the BEAM code of a single function into Icode. +%% Returns a tuple whose first argument is list of {{M,F,A}, ICode} +%% pairs, where the first entry is that of the given MFA, and the +%% following (in undefined order) are those of the funs that are +%% defined in the function, and recursively, in the funs. The +%% second argument of the tuple is the HiPE compiler options +%% contained in the file. +%% @end +%%----------------------------------------------------------------------- + +-spec mfa(list(), mfa(), comp_options()) -> hipe_beam_to_icode_ret(). + +mfa(BeamFuns, {M,F,A} = MFA, Options) + when is_atom(M), is_atom(F), is_integer(A) -> + BeamCode0 = [beam_disasm:function__code(Fn) || Fn <- BeamFuns], + {ModCode, ClosureInfo} = preprocess_code(BeamCode0), + mfa_loop([MFA], [], sets:new(), ModCode, ClosureInfo, Options). + +mfa_loop([{M,F,A} = MFA | MFAs], Acc, Seen, ModCode, ClosureInfo, + Options) when is_atom(M), is_atom(F), is_integer(A) -> + case sets:is_element(MFA, Seen) of + true -> + mfa_loop(MFAs, Acc, Seen, ModCode, ClosureInfo, Options); + false -> + {Icode, FunMFAs} = mfa_get(M, F, A, ModCode, ClosureInfo, Options), + mfa_loop(FunMFAs ++ MFAs, [{MFA, Icode} | Acc], + sets:add_element(MFA, Seen), + ModCode, ClosureInfo, Options) + end; +mfa_loop([], Acc, _, _, _, _) -> + lists:reverse(Acc). + +mfa_get(M, F, A, ModCode, ClosureInfo, Options) -> + BeamCode = get_fun(ModCode, M,F,A), + pp_beam([BeamCode], Options), % cheat by using a list + Icode = trans_mfa_code(M,F,A, BeamCode, ClosureInfo), + FunMFAs = get_fun_mfas(BeamCode), + {Icode, FunMFAs}. + +get_fun_mfas([{patched_make_fun,{M,F,A} = MFA,_,_,_}|BeamCode]) + when is_atom(M), is_atom(F), is_integer(A) -> + [MFA|get_fun_mfas(BeamCode)]; +get_fun_mfas([_|BeamCode]) -> + get_fun_mfas(BeamCode); +get_fun_mfas([]) -> + []. + +%%----------------------------------------------------------------------- +%% The main translation function. +%%----------------------------------------------------------------------- + +trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo) -> + ?no_debug_msg("disassembling: {~p,~p,~p} ...", [M,F,A]), + hipe_gensym:init(icode), + %% Extract the function arguments + FunArgs = extract_fun_args(A), + %% Record the function arguments + FunLbl = mk_label(new), + Env1 = env__mk_env(M, F, A, hipe_icode:label_name(FunLbl)), + Code1 = lists:flatten(trans_fun(FunBeamCode,Env1)), + Code2 = fix_fallthroughs(fix_catches(Code1)), + MFA = {M,F,A}, + %% Debug code + ?IF_DEBUG_LEVEL(5, + {Code3,_Env3} = ?mk_debugcode(MFA, Env2, Code2), + {Code3,_Env3} = {Code2,Env1}), + %% For stack optimization + Leafness = leafness(Code3), + IsLeaf = is_leaf_code(Leafness), + Code4 = + [FunLbl | + case needs_redtest(Leafness) of + false -> Code3; + true -> [mk_redtest()|Code3] + end], + IsClosure = get_closure_info(MFA, ClosureInfo) =/= not_a_closure, + Code5 = hipe_icode:mk_icode(MFA, FunArgs, IsClosure, IsLeaf, + remove_dead_code(Code4), + hipe_gensym:var_range(icode), + hipe_gensym:label_range(icode)), + Icode = %% If this function is the code for a closure ... + case get_closure_info(MFA, ClosureInfo) of + not_a_closure -> Code5; + CI -> %% ... then patch the code to + %% get the free_vars from the closure + patch_closure_entry(Code5, CI) + end, + ?no_debug_msg("ok~n", []), + Icode. + +mk_redtest() -> hipe_icode:mk_primop([], redtest, []). + +leafness(Is) -> % -> true, selfrec, or false + leafness(Is, true). + +leafness([], Leafness) -> + Leafness; +leafness([I|Is], Leafness) -> + case I of + #icode_comment{} -> + %% BEAM self-tailcalls become gotos, but they leave + %% a trace behind in comments. Check those to ensure + %% that the computed leafness is correct. Needed to + %% prevent redtest elimination in those cases. + NewLeafness = + case hipe_icode:comment_text(I) of + 'tail_recursive' -> selfrec; % call_last to selfrec + 'self_tail_recursive' -> selfrec; % call_only to selfrec + _ -> Leafness + end, + leafness(Is, NewLeafness); + #icode_call{} -> + case hipe_icode:call_type(I) of + 'primop' -> + case hipe_icode:call_fun(I) of + call_fun -> false; % Calls closure + enter_fun -> false; % Calls closure + #apply_N{} -> false; + _ -> leafness(Is, Leafness) % Other primop calls are ok + end; + T when T =:= 'local' orelse T =:= 'remote' -> + {M,F,A} = hipe_icode:call_fun(I), + case erlang:is_builtin(M, F, A) of + true -> leafness(Is, Leafness); + false -> false + end + end; + #icode_enter{} -> + case hipe_icode:enter_type(I) of + 'primop' -> + case hipe_icode:enter_fun(I) of + enter_fun -> false; + #apply_N{} -> false; + _ -> + %% All primops should be ok except those excluded above, + %% except we don't actually tailcall them... + io:format("leafness: unexpected enter to primop ~w\n", [I]), + true + end; + T when T =:= 'local' orelse T =:= 'remote' -> + {M,F,A} = hipe_icode:enter_fun(I), + case erlang:is_builtin(M, F, A) of + true -> leafness(Is, Leafness); + _ -> false + end + end; + _ -> leafness(Is, Leafness) + end. + +%% XXX: this old stuff is passed around but essentially unused +is_leaf_code(Leafness) -> + case Leafness of + true -> true; + selfrec -> true; + false -> false + end. + +needs_redtest(Leafness) -> + case Leafness of + true -> false; + selfrec -> true; + false -> true + end. + +%%----------------------------------------------------------------------- +%% The main translation switch. +%%----------------------------------------------------------------------- + +%%--- label & func_info combo --- +trans_fun([{label,B},{label,_}, + {func_info,M,F,A},{label,L}|Instructions], Env) -> + trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env); +trans_fun([{label,B}, + {func_info,{atom,_M},{atom,_F},_A}, + {label,L}|Instructions], Env) -> + %% Emit code to handle function_clause errors. The BEAM test instructions + %% branch to this label if they fail during function clause selection. + %% Obviously, we must goto past this error point on normal entry. + Begin = mk_label(B), + V = mk_var(new), + EntryPt = mk_label(L), + Goto = hipe_icode:mk_goto(hipe_icode:label_name(EntryPt)), + Mov = hipe_icode:mk_move(V, hipe_icode:mk_const(function_clause)), + Fail = hipe_icode:mk_fail([V],error), + [Goto, Begin, Mov, Fail, EntryPt | trans_fun(Instructions, Env)]; +%%--- label --- +trans_fun([{label,L1},{label,L2}|Instructions], Env) -> + %% Old BEAM code can have two consecutive labels. + Lab1 = mk_label(L1), + Lab2 = mk_label(L2), + Goto = hipe_icode:mk_goto(map_label(L2)), + [Lab1, Goto, Lab2 | trans_fun(Instructions, Env)]; +trans_fun([{label,L}|Instructions], Env) -> + [mk_label(L) | trans_fun(Instructions, Env)]; +%%--- int_code_end --- SHOULD NEVER OCCUR HERE +%%--- call --- +trans_fun([{call,_N,{_M,_F,A}=MFA}|Instructions], Env) -> + Args = extract_fun_args(A), + Dst = [mk_var({r,0})], + I = trans_call(MFA, Dst, Args, local), + [I | trans_fun(Instructions, Env)]; +%%--- call_last --- +%% Differs from call_only in that it deallocates the environment +trans_fun([{call_last,_N,{_M,_F,A}=MFA,_}|Instructions], Env) -> + %% IS IT OK TO IGNORE LAST ARG ?? + ?no_debug_msg(" translating call_last: ~p ...~n", [Env]), + case env__get_mfa(Env) of + MFA -> + %% Does this case really happen, or is it covered by call_only? + Entry = env__get_entry(Env), + [hipe_icode:mk_comment('tail_recursive'), % needed by leafness/2 + hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)]; + _ -> + Args = extract_fun_args(A), + I = trans_enter(MFA, Args, local), + [I | trans_fun(Instructions, Env)] + end; +%%--- call_only --- +%% Used when the body contains only one call in which case +%% an environment is not needed/created. +trans_fun([{call_only,_N,{_M,_F,A}=MFA}|Instructions], Env) -> + ?no_debug_msg(" translating call_only: ~p ...~n", [Env]), + case env__get_mfa(Env) of + MFA -> + Entry = env__get_entry(Env), + [hipe_icode:mk_comment('self_tail_recursive'), % needed by leafness/2 + hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)]; + _ -> + Args = extract_fun_args(A), + I = trans_enter(MFA,Args,local), + [I | trans_fun(Instructions,Env)] + end; +%%--- call_ext --- +trans_fun([{call_ext,_N,{extfunc,M,F,A}}|Instructions], Env) -> + Args = extract_fun_args(A), + Dst = [mk_var({r,0})], + I = trans_call({M,F,A},Dst,Args,remote), + [hipe_icode:mk_comment('call_ext'),I | trans_fun(Instructions,Env)]; +%%--- call_ext_last --- +trans_fun([{call_ext_last,_N,{extfunc,M,F,A},_}|Instructions], Env) -> + %% IS IT OK TO IGNORE LAST ARG ?? + Args = extract_fun_args(A), + %% Dst = [mk_var({r,0})], + I = trans_enter({M,F,A},Args,remote), + [hipe_icode:mk_comment('call_ext_last'), I | trans_fun(Instructions,Env)]; +%%--- bif0 --- +trans_fun([{bif,BifName,nofail,[],Reg}|Instructions], Env) -> + BifInst = trans_bif0(BifName,Reg), + [hipe_icode:mk_comment({bif0,BifName}),BifInst|trans_fun(Instructions,Env)]; +%%--- bif1 --- +trans_fun([{bif,BifName,{f,Lbl},[_] = Args,Reg}|Instructions], Env) -> + {BifInsts,Env1} = trans_bif(1,BifName,Lbl,Args,Reg,Env), + [hipe_icode:mk_comment({bif1,BifName})|BifInsts] ++ trans_fun(Instructions,Env1); +%%--- bif2 --- +trans_fun([{bif,BifName,{f,Lbl},[_,_] = Args,Reg}|Instructions], Env) -> + {BifInsts,Env1} = trans_bif(2,BifName,Lbl,Args,Reg,Env), + [hipe_icode:mk_comment({bif2,BifName})|BifInsts] ++ trans_fun(Instructions,Env1); +%%--- allocate +trans_fun([{allocate,StackSlots,_}|Instructions], Env) -> + trans_allocate(StackSlots) ++ trans_fun(Instructions,Env); +%%--- allocate_heap +trans_fun([{allocate_heap,StackSlots,_,_}|Instructions], Env) -> + trans_allocate(StackSlots) ++ trans_fun(Instructions,Env); +%%--- allocate_zero +trans_fun([{allocate_zero,StackSlots,_}|Instructions], Env) -> + trans_allocate(StackSlots) ++ trans_fun(Instructions,Env); +%%--- allocate_heap_zero +trans_fun([{allocate_heap_zero,StackSlots,_,_}|Instructions], Env) -> + trans_allocate(StackSlots) ++ trans_fun(Instructions,Env); +%%--- test_heap --- IGNORED ON PURPOSE +trans_fun([{test_heap,_,_}|Instructions], Env) -> + trans_fun(Instructions,Env); +%%--- init --- IGNORED - CORRECT?? +trans_fun([{init,_}|Instructions], Env) -> + trans_fun(Instructions,Env); +%%--- deallocate --- IGNORED ON PURPOSE +trans_fun([{deallocate,_}|Instructions], Env) -> + trans_fun(Instructions,Env); +%%--- return --- +trans_fun([return|Instructions], Env) -> + [hipe_icode:mk_return([mk_var({r,0})]) | trans_fun(Instructions,Env)]; +%%--- send --- +trans_fun([send|Instructions], Env) -> + I = hipe_icode:mk_call([mk_var({r,0})], erlang, send, + [mk_var({x,0}),mk_var({x,1})], remote), + [I | trans_fun(Instructions,Env)]; +%%--- remove_message --- +trans_fun([remove_message|Instructions], Env) -> + [hipe_icode:mk_primop([],select_msg,[]) | trans_fun(Instructions,Env)]; +%%--- timeout --- +trans_fun([timeout|Instructions], Env) -> + [hipe_icode:mk_primop([],clear_timeout,[]) | trans_fun(Instructions,Env)]; +%%--- loop_rec --- +trans_fun([{loop_rec,{_,Lbl},Reg}|Instructions], Env) -> + {Movs,[Temp],Env1} = get_constants_in_temps([Reg],Env), + GotitLbl = mk_label(new), + ChkGetMsg = hipe_icode:mk_primop([Temp],check_get_msg,[], + hipe_icode:label_name(GotitLbl), + map_label(Lbl)), + Movs ++ [ChkGetMsg, GotitLbl | trans_fun(Instructions,Env1)]; +%%--- loop_rec_end --- +trans_fun([{loop_rec_end,{_,Lbl}}|Instructions], Env) -> + Loop = hipe_icode:mk_goto(map_label(Lbl)), + [hipe_icode:mk_primop([],next_msg,[]), Loop | trans_fun(Instructions,Env)]; +%%--- wait --- +trans_fun([{wait,{_,Lbl}}|Instructions], Env) -> + Susp = hipe_icode:mk_primop([],suspend_msg,[]), + Loop = hipe_icode:mk_goto(map_label(Lbl)), + [Susp, Loop | trans_fun(Instructions,Env)]; +%%--- wait_timeout --- +trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) -> + {Movs,[_]=Temps,Env1} = get_constants_in_temps([Reg],Env), + SetTmout = hipe_icode:mk_primop([],set_timeout,Temps), + DoneLbl = mk_label(new), + SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[], + map_label(Lbl),hipe_icode:label_name(DoneLbl)), + Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)]; +%%-------------------------------------------------------------------- +%%--- Translation of arithmetics {bif,ArithOp, ...} --- +%%-------------------------------------------------------------------- +trans_fun([{arithbif,ArithOp,{f,L},SrcRs,DstR}|Instructions], Env) -> + {ICode,NewEnv} = trans_arith(ArithOp,SrcRs,DstR,L,Env), + ICode ++ trans_fun(Instructions,NewEnv); +%%-------------------------------------------------------------------- +%%--- Translation of arithmetic tests {test,is_ARITHTEST, ...} --- +%%-------------------------------------------------------------------- +%%--- is_lt --- +trans_fun([{test,is_lt,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_test_guard('<',Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%--- is_ge --- +trans_fun([{test,is_ge,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_test_guard('>=',Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%--- is_eq --- +trans_fun([{test,is_eq,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_is_eq(Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%--- is_ne --- +trans_fun([{test,is_ne,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_is_ne(Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%--- is_eq_exact --- +trans_fun([{test,is_eq_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_is_eq_exact(Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%--- is_ne_exact --- +trans_fun([{test,is_ne_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) -> + {ICode,Env1} = trans_is_ne_exact(Lbl,Arg1,Arg2,Env), + ICode ++ trans_fun(Instructions,Env1); +%%-------------------------------------------------------------------- +%%--- Translation of type tests {test,is_TYPE, ...} --- +%%-------------------------------------------------------------------- +%%--- is_integer --- +trans_fun([{test,is_integer,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(integer,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_float --- +trans_fun([{test,is_float,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(float,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_number --- +trans_fun([{test,is_number,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(number,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_atom --- +trans_fun([{test,is_atom,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(atom,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_pid --- +trans_fun([{test,is_pid,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(pid,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_ref --- +trans_fun([{test,is_reference,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(reference,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_port --- +trans_fun([{test,is_port,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(port,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_nil --- +trans_fun([{test,is_nil,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(nil,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_binary --- +trans_fun([{test,is_binary,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(binary,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_constant --- +trans_fun([{test,is_constant,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(constant,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_list --- +trans_fun([{test,is_list,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(list,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_nonempty_list --- +trans_fun([{test,is_nonempty_list,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(cons,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- is_tuple --- +trans_fun([{test,is_tuple,{f,_Lbl}=FLbl,[Xreg]}, + {test,test_arity,FLbl,[Xreg,_]=Args}|Instructions], Env) -> + trans_fun([{test,test_arity,FLbl,Args}|Instructions],Env); +trans_fun([{test,is_tuple,{_,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(tuple,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- test_arity --- +trans_fun([{test,test_arity,{f,Lbl},[Reg,N]}|Instructions], Env) -> + True = mk_label(new), + I = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N}, + hipe_icode:label_name(True),map_label(Lbl)), + [I,True | trans_fun(Instructions,Env)]; +%%-------------------------------------------------------------------- +%%--- select_val --- +trans_fun([{select_val,Reg,{f,Lbl},{list,Cases}}|Instructions], Env) -> + {SwVar,CasePairs} = trans_select_stuff(Reg,Cases), + Len = length(CasePairs), + I = hipe_icode:mk_switch_val(SwVar,map_label(Lbl),Len,CasePairs), + ?no_debug_msg("switch_val instr is ~p~n",[I]), + [I | trans_fun(Instructions,Env)]; +%%--- select_tuple_arity --- +trans_fun([{select_tuple_arity,Reg,{f,Lbl},{list,Cases}}|Instructions],Env) -> + {SwVar,CasePairs} = trans_select_stuff(Reg,Cases), + Len = length(CasePairs), + I = hipe_icode:mk_switch_tuple_arity(SwVar,map_label(Lbl),Len,CasePairs), + ?no_debug_msg("switch_tuple_arity instr is ~p~n",[I]), + [I | trans_fun(Instructions,Env)]; +%%--- jump --- +trans_fun([{jump,{_,L}}|Instructions], Env) -> + Label = mk_label(L), + I = hipe_icode:mk_goto(hipe_icode:label_name(Label)), + [I | trans_fun(Instructions,Env)]; +%%--- move --- +trans_fun([{move,Src,Dst}|Instructions], Env) -> + Dst1 = mk_var(Dst), + Src1 = trans_arg(Src), + [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)]; +%%--- catch --- ITS PROCESSING IS POSTPONED +trans_fun([{'catch',N,{_,EndLabel}}|Instructions], Env) -> + NewContLbl = mk_label(new), + [{'catch',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)]; +%%--- catch_end --- ITS PROCESSING IS POSTPONED +trans_fun([{catch_end,_N}=I|Instructions], Env) -> + [I | trans_fun(Instructions,Env)]; +%%--- try --- ITS PROCESSING IS POSTPONED +trans_fun([{'try',N,{_,EndLabel}}|Instructions], Env) -> + NewContLbl = mk_label(new), + [{'try',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)]; +%%--- try_end --- +trans_fun([{try_end,_N}|Instructions], Env) -> + [hipe_icode:mk_end_try() | trans_fun(Instructions,Env)]; +%%--- try_case --- ITS PROCESSING IS POSTPONED +trans_fun([{try_case,_N}=I|Instructions], Env) -> + [I | trans_fun(Instructions,Env)]; +%%--- try_case_end --- +trans_fun([{try_case_end,Arg}|Instructions], Env) -> + BadArg = trans_arg(Arg), + ErrVar = mk_var(new), + Vs = [mk_var(new)], + Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(try_clause)), + Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]), + Fail = hipe_icode:mk_fail(Vs,error), + [Atom,Tuple,Fail | trans_fun(Instructions,Env)]; +%%--- raise --- +trans_fun([{raise,{f,0},[Reg1,Reg2],{x,0}}|Instructions], Env) -> + V1 = trans_arg(Reg1), + V2 = trans_arg(Reg2), + Fail = hipe_icode:mk_fail([V1,V2],rethrow), + [Fail | trans_fun(Instructions,Env)]; +%%--- get_list --- +trans_fun([{get_list,List,Head,Tail}|Instructions], Env) -> + TransList = [trans_arg(List)], + I1 = hipe_icode:mk_primop([mk_var(Head)],unsafe_hd,TransList), + I2 = hipe_icode:mk_primop([mk_var(Tail)],unsafe_tl,TransList), + %% Handle the cases where the dest overwrites the src!! + if + Head =/= List -> + [I1, I2 | trans_fun(Instructions,Env)]; + Tail =/= List -> + [I2, I1 | trans_fun(Instructions,Env)]; + true -> + %% XXX: We should take care of this case!!!!! + ?error_msg("hd and tl regs identical in get_list~n",[]), + erlang:error(not_handled) + end; +%%--- get_tuple_element --- +trans_fun([{get_tuple_element,Xreg,Index,Dst}|Instructions], Env) -> + I = hipe_icode:mk_primop([mk_var(Dst)], + #unsafe_element{index=Index+1}, + [trans_arg(Xreg)]), + [I | trans_fun(Instructions,Env)]; +%%--- set_tuple_element --- +trans_fun([{set_tuple_element,Elem,Tuple,Index}|Instructions], Env) -> + Elem1 = trans_arg(Elem), + I = hipe_icode:mk_primop([mk_var(Tuple)], + #unsafe_update_element{index=Index+1}, + [mk_var(Tuple),Elem1]), + [I | trans_fun(Instructions,Env)]; +%%--- put_string --- +trans_fun([{put_string,_Len,String,Dst}|Instructions], Env) -> + Mov = hipe_icode:mk_move(mk_var(Dst),trans_const(String)), + [Mov | trans_fun(Instructions,Env)]; +%%--- put_list --- +trans_fun([{put_list,Car,Cdr,Dest}|Instructions], Env) -> + {M1,V1,Env2} = mk_move_and_var(Car,Env), + {M2,V2,Env3} = mk_move_and_var(Cdr,Env2), + D = mk_var(Dest), + M1 ++ M2 ++ [hipe_icode:mk_primop([D],cons,[V1,V2]) + | trans_fun(Instructions,Env3)]; +%%--- put_tuple --- +trans_fun([{put_tuple,_Size,Reg}|Instructions], Env) -> + {Moves,Instructions2,Vars,Env2} = trans_puts(Instructions,Env), + Dest = [mk_var(Reg)], + Src = lists:reverse(Vars), + Primop = hipe_icode:mk_primop(Dest,mktuple,Src), + Moves ++ [Primop | trans_fun(Instructions2,Env2)]; +%%--- put --- SHOULD NOT REALLY EXIST HERE; put INSTRUCTIONS ARE HANDLED ABOVE. +%%--- badmatch --- +trans_fun([{badmatch,Arg}|Instructions], Env) -> + BadVar = trans_arg(Arg), + ErrVar = mk_var(new), + Vs = [mk_var(new)], + Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(badmatch)), + Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadVar]), + Fail = hipe_icode:mk_fail(Vs,error), + [Atom,Tuple,Fail | trans_fun(Instructions,Env)]; +%%--- if_end --- +trans_fun([if_end|Instructions], Env) -> + V = mk_var(new), + Mov = hipe_icode:mk_move(V,hipe_icode:mk_const(if_clause)), + Fail = hipe_icode:mk_fail([V],error), + [Mov,Fail | trans_fun(Instructions, Env)]; +%%--- case_end --- +trans_fun([{case_end,Arg}|Instructions], Env) -> + BadArg = trans_arg(Arg), + ErrVar = mk_var(new), + Vs = [mk_var(new)], + Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(case_clause)), + Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]), + Fail = hipe_icode:mk_fail(Vs,error), + [Atom,Tuple,Fail | trans_fun(Instructions,Env)]; +%%--- enter_fun --- +trans_fun([{call_fun,N},{deallocate,_},return|Instructions], Env) -> + Args = extract_fun_args(N+1), %% +1 is for the fun itself + [hipe_icode:mk_comment('enter_fun'), + hipe_icode:mk_enter_primop(enter_fun,Args) | trans_fun(Instructions,Env)]; +%%--- call_fun --- +trans_fun([{call_fun,N}|Instructions], Env) -> + Args = extract_fun_args(N+1), %% +1 is for the fun itself + Dst = [mk_var({r,0})], + [hipe_icode:mk_comment('call_fun'), + hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)]; +%%--- patched_make_fun --- make_fun/make_fun2 after fixes +trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) -> + Args = extract_fun_args(FreeVarNum), + Dst = [mk_var({r,0})], + Fun = hipe_icode:mk_primop(Dst, + #mkfun{mfa=MFA,magic_num=Magic,index=Index}, + Args), + ?no_debug_msg("mkfun translates to: ~p~n",[Fun]), + [Fun | trans_fun(Instructions,Env)]; +%%--- is_function --- +trans_fun([{test,is_function,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(function,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%--- call_ext_only --- +trans_fun([{call_ext_only,_N,{extfunc,M,F,A}}|Instructions], Env) -> + Args = extract_fun_args(A), + I = trans_enter({M,F,A}, Args, remote), + [hipe_icode:mk_comment('call_ext_only'), I | trans_fun(Instructions,Env)]; +%%-------------------------------------------------------------------- +%%--- Translation of binary instructions --- +%%-------------------------------------------------------------------- +%% This code uses a somewhat unorthodox translation: +%% Since we do not want non-erlang values as arguments to Icode +%% instructions some compile time constants are coded into the +%% name of the function (or rather the primop). +%% TODO: Make sure all cases of argument types are covered. +%%-------------------------------------------------------------------- +trans_fun([{test,bs_start_match2,{f,Lbl},[X,_Live,Max,Ms]}|Instructions], Env) -> + Bin = trans_arg(X), + MsVar = mk_var(Ms), + trans_op_call({hipe_bs_primop, {bs_start_match, Max}}, Lbl, [Bin], + [MsVar], Env, Instructions); +trans_fun([{test,bs_get_float2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}| + Instructions], Env) -> + Dst = mk_var(X), + MsVar = mk_var(Ms), + Flags = resolve_native_endianess(Flags0), + {Name, Args} = + case Size of + {integer, NoBits} when is_integer(NoBits), NoBits >= 0 -> + {{bs_get_float,NoBits*Unit,Flags}, [MsVar]}; + {integer, NoBits} when is_integer(NoBits), NoBits < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + BitReg -> + Bits = mk_var(BitReg), + {{bs_get_float,Unit,Flags}, [Bits,MsVar]} + end, + trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions); +trans_fun([{test,bs_get_integer2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}| + Instructions], Env) -> + Dst = mk_var(X), + MsVar = mk_var(Ms), + Flags = resolve_native_endianess(Flags0), + {Name, Args} = + case Size of + {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> + {{bs_get_integer,NoBits*Unit,Flags}, [MsVar]}; + {integer,NoBits} when is_integer(NoBits), NoBits < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + BitReg -> + Bits = mk_var(BitReg), + {{bs_get_integer,Unit,Flags}, [MsVar,Bits]} + end, + trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions); +trans_fun([{test,bs_get_binary2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags},X]}| + Instructions], Env) -> + MsVar = mk_var(Ms), + {Name, Args, Dsts} = + case Size of + {atom, all} -> %% put all bits + if Ms =:= X -> + {{bs_get_binary_all,Unit,Flags},[MsVar],[mk_var(X)]}; + true -> + {{bs_get_binary_all_2,Unit,Flags},[MsVar],[mk_var(X),MsVar]} + end; + {integer, NoBits} when is_integer(NoBits), NoBits >= 0 -> + {{bs_get_binary,NoBits*Unit,Flags}, [MsVar], [mk_var(X),MsVar]};%% Create a N*Unit bits subbinary + {integer, NoBits} when is_integer(NoBits), NoBits < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + BitReg -> % Use a number of bits only known at runtime. + Bits = mk_var(BitReg), + {{bs_get_binary,Unit,Flags}, [MsVar,Bits], [mk_var(X),MsVar]} + end, + trans_op_call({hipe_bs_primop,Name}, Lbl, Args, Dsts, Env, Instructions); +trans_fun([{test,bs_skip_bits2,{f,Lbl},[Ms,Size,NumBits,{field_flags,Flags}]}| + Instructions], Env) -> + %% the current match buffer + MsVar = mk_var(Ms), + {Name, Args} = + case Size of + {atom, all} -> %% Skip all bits + {{bs_skip_bits_all,NumBits,Flags},[MsVar]}; + {integer, BitSize} when is_integer(BitSize), BitSize >= 0-> %% Skip N bits + {{bs_skip_bits,BitSize*NumBits}, [MsVar]}; + {integer, BitSize} when is_integer(BitSize), BitSize < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + X -> % Skip a number of bits only known at runtime. + Src = mk_var(X), + {{bs_skip_bits,NumBits},[MsVar,Src]} + end, + trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [MsVar], Env, Instructions); +trans_fun([{test,bs_test_unit,{f,Lbl},[Ms,Unit]}| + Instructions], Env) -> + %% the current match buffer + MsVar = mk_var(Ms), + trans_op_call({hipe_bs_primop,{bs_test_unit,Unit}}, Lbl, + [MsVar], [], Env, Instructions); +trans_fun([{test,bs_match_string,{f,Lbl},[Ms,BitSize,Bin]}| + Instructions], Env) -> + True = mk_label(new), + FalseLabName = map_label(Lbl), + TrueLabName = hipe_icode:label_name(True), + MsVar = mk_var(Ms), + TmpVar = mk_var(new), + ByteSize = BitSize div 8, + ExtraBits = BitSize rem 8, + WordSize = hipe_rtl_arch:word_size(), + if ExtraBits =:= 0 -> + trans_op_call({hipe_bs_primop,{bs_match_string,Bin,ByteSize}}, Lbl, + [MsVar], [MsVar], Env, Instructions); + BitSize =< ((WordSize * 8) - 5) -> + <> = Bin, + {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,BitSize,0}}, Lbl, + [MsVar], [TmpVar, MsVar], Env), + I2 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), + I1 ++ [I2,True] ++ trans_fun(Instructions, Env1); + true -> + <> = Bin, + {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_match_string,RealBin,ByteSize}}, Lbl, + [MsVar], [MsVar], Env), + {I2,Env2} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,ExtraBits,0}}, Lbl, + [MsVar], [TmpVar, MsVar], Env1), + I3 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), + I1 ++ I2 ++ [I3,True] ++ trans_fun(Instructions, Env2) + end; +trans_fun([{bs_context_to_binary,Var}|Instructions], Env) -> + %% the current match buffer + IVars = [trans_arg(Var)], + [hipe_icode:mk_primop(IVars,{hipe_bs_primop,bs_context_to_binary},IVars)| + trans_fun(Instructions, Env)]; +trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}| + Instructions], Env) -> + %% the current match buffer + SizeArg = trans_arg(Size), + BinArg = trans_arg(Binary), + IcodeDst = mk_var(Dst), + Offset = mk_var(reg), + Base = mk_var(reg), + trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg], + [IcodeDst,Base,Offset], + Base, Offset, Env, Instructions); +trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}| + Instructions], Env) -> + %% the current match buffer + SizeArg = trans_arg(Size), + BinArg = trans_arg(Binary), + IcodeDst = mk_var(Dst), + Offset = mk_var(reg), + Base = mk_var(reg), + trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}}, + Lbl,[SizeArg,BinArg], + [IcodeDst,Base,Offset], + Base, Offset, Env, Instructions); +trans_fun([bs_init_writable|Instructions], Env) -> + Vars = [mk_var({x,0})], %{x,0} is implict arg and dst + [hipe_icode:mk_primop(Vars,{hipe_bs_primop,bs_init_writable},Vars), + trans_fun(Instructions, Env)]; +trans_fun([{bs_save2,Ms,IndexName}|Instructions], Env) -> + Index = + case IndexName of + {atom, start} -> 0; + _ -> IndexName+1 + end, + MsVars = [mk_var(Ms)], + [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_save,Index}},MsVars) | + trans_fun(Instructions, Env)]; +trans_fun([{bs_restore2,Ms,IndexName}|Instructions], Env) -> + Index = + case IndexName of + {atom, start} -> 0; + _ -> IndexName+1 + end, + MsVars = [mk_var(Ms)], + [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_restore,Index}},MsVars) | + trans_fun(Instructions, Env)]; +trans_fun([{test,bs_test_tail2,{f,Lbl},[Ms,Numbits]}| Instructions], Env) -> + MsVar = mk_var(Ms), + trans_op_call({hipe_bs_primop,{bs_test_tail,Numbits}}, + Lbl, [MsVar], [], Env, Instructions); +%%-------------------------------------------------------------------- +%% New bit syntax instructions added in February 2004 (R10B). +%%-------------------------------------------------------------------- +trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| + Instructions], Env) -> + Dst = mk_var(X), + Flags = resolve_native_endianess(Flags0), + Offset = mk_var(reg), + Base = mk_var(reg), + {Name, Args} = + case Size of + NoBytes when is_integer(NoBytes) -> + {{bs_init, Size, Flags}, []}; + BitReg -> + Bits = mk_var(BitReg), + {{bs_init, Flags}, [Bits]} + end, + trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset], + Base, Offset, Env, Instructions); +trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| + Instructions], Env) -> + Dst = mk_var(X), + Flags = resolve_native_endianess(Flags0), + Offset = mk_var(reg), + Base = mk_var(reg), + {Name, Args} = + case Size of + NoBits when is_integer(NoBits) -> + {{bs_init_bits, NoBits, Flags}, []}; + BitReg -> + Bits = mk_var(BitReg), + {{bs_init_bits, Flags}, [Bits]} + end, + trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset], + Base, Offset, Env, Instructions); +trans_fun([{bs_bits_to_bytes2, Bits, Bytes}|Instructions], Env) -> + Src = trans_arg(Bits), + Dst = mk_var(Bytes), + [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])| + trans_fun(Instructions,Env)]; +trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> + Dst = mk_var(Res), + Temp = mk_var(new), + MultIs = + case {New,Unit} of + {{integer, NewInt}, _} -> + [hipe_icode:mk_move(Temp, hipe_icode:mk_const(NewInt*Unit))]; + {_, 1} -> + NewVar = mk_var(New), + [hipe_icode:mk_move(Temp, NewVar)]; + _ -> + NewVar = mk_var(New), + if Lbl =:= 0 -> + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)])]; + true -> + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), Lbl), + Succ] + end + end, + Succ2 = mk_label(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {Lbl, []} + end, + IsPos = + [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], + hipe_icode:label_name(Succ2), FailLblName)] ++ + FailCode ++ [Succ2], + AddI = + case Old of + {integer,OldInt} -> + hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); + _ -> + OldVar = mk_var(Old), + hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + end, + MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; +%%-------------------------------------------------------------------- +%% Bit syntax instructions added in R12B-5 (Fall 2008) +%%-------------------------------------------------------------------- +trans_fun([{bs_utf8_size,{f,Lbl},A2,A3}|Instructions], Env) -> + Bin = trans_arg(A2), + Dst = mk_var(A3), + trans_op_call({hipe_bs_primop, bs_utf8_size}, Lbl, [Bin], [Dst], Env, Instructions); +trans_fun([{test,bs_get_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags},X]} | + Instructions], Env) -> + trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env); +trans_fun([{test,bs_skip_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags}]} | + Instructions], Env) -> + trans_bs_get_or_skip_utf8(Lbl, Ms, 'new', Instructions, Env); +trans_fun([{bs_utf16_size,{f,Lbl},A2,A3}|Instructions], Env) -> + Bin = trans_arg(A2), + Dst = mk_var(A3), + trans_op_call({hipe_bs_primop, bs_utf16_size}, Lbl, [Bin], [Dst], Env, Instructions); +trans_fun([{test,bs_get_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} | + Instructions], Env) -> + trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env); +trans_fun([{test,bs_skip_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} | + Instructions], Env) -> + trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, 'new', Instructions, Env); +trans_fun([{test,bs_get_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} | Instructions], Env) -> + trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env); +trans_fun([{test,bs_skip_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} | Instructions], Env) -> + trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, 'new', Instructions, Env); +%%-------------------------------------------------------------------- +%%--- Translation of floating point instructions --- +%%-------------------------------------------------------------------- +%%--- fclearerror --- +trans_fun([fclearerror|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + [hipe_icode:mk_primop([], fclearerror, []) | + trans_fun(Instructions,Env)]; + _ -> + trans_fun(Instructions,Env) + end; +%%--- fcheckerror --- +trans_fun([{fcheckerror,{_,Fail}}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + ContLbl = mk_label(new), + case Fail of + 0 -> + [hipe_icode:mk_primop([], fcheckerror, [], + hipe_icode:label_name(ContLbl), []), + ContLbl | trans_fun(Instructions,Env)]; + _ -> %% Can this happen? + {Guard,Env1} = + make_guard([], fcheckerror, [], + hipe_icode:label_name(ContLbl), map_label(Fail), Env), + [Guard, ContLbl | trans_fun(Instructions,Env1)] + end; + _ -> + trans_fun(Instructions, Env) + end; +%%--- fmove --- +trans_fun([{fmove,Src,Dst}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + Dst1 = mk_var(Dst), + Src1 = trans_arg(Src), + case{hipe_icode:is_fvar(Dst1), + hipe_icode:is_fvar(Src1)} of + {true, true} -> %% fvar := fvar + [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)]; + {false, true} -> %% var := fvar + [hipe_icode:mk_primop([Dst1], unsafe_tag_float, [Src1]) | + trans_fun(Instructions,Env)]; + {true, false} -> %% fvar := var or fvar := constant + [hipe_icode:mk_primop([Dst1], unsafe_untag_float, [Src1]) | + trans_fun(Instructions,Env)] + end; + _ -> + trans_fun([{move,Src,Dst}|Instructions], Env) + end; +%%--- fconv --- +trans_fun([{fconv,Eterm,FReg}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + Src = trans_arg(Eterm), + ContLbl = mk_label(new), + Dst = mk_var(FReg), + [hipe_icode:mk_primop([Dst], conv_to_float, [Src], + hipe_icode:label_name(ContLbl), []), + ContLbl| trans_fun(Instructions, Env)]; + _ -> + trans_fun([{fmove,Eterm,FReg}|Instructions], Env) + end; +%%--- fadd --- +trans_fun([{arithfbif,fadd,Lab,SrcRs,DstR}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + trans_fun([{arithbif,fp_add,Lab,SrcRs,DstR}|Instructions], Env); + _ -> + trans_fun([{arithbif,'+',Lab,SrcRs,DstR}|Instructions], Env) + end; +%%--- fsub --- +trans_fun([{arithfbif,fsub,Lab,SrcRs,DstR}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + trans_fun([{arithbif,fp_sub,Lab,SrcRs,DstR}|Instructions], Env); + _ -> + trans_fun([{arithbif,'-',Lab,SrcRs,DstR}|Instructions], Env) + end; +%%--- fmult --- +trans_fun([{arithfbif,fmul,Lab,SrcRs,DstR}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + trans_fun([{arithbif,fp_mul,Lab,SrcRs,DstR}|Instructions], Env); + _ -> + trans_fun([{arithbif,'*',Lab,SrcRs,DstR}|Instructions], Env) + end; +%%--- fdiv --- +trans_fun([{arithfbif,fdiv,Lab,SrcRs,DstR}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + trans_fun([{arithbif,fp_div,Lab,SrcRs,DstR}|Instructions], Env); + _ -> + trans_fun([{arithbif,'/',Lab,SrcRs,DstR}|Instructions], Env) + end; +%%--- fnegate --- +trans_fun([{arithfbif,fnegate,Lab,[SrcR],DestR}|Instructions], Env) -> + case get(hipe_inline_fp) of + true -> + Src = trans_arg(SrcR), + Dst = mk_var(DestR), + [hipe_icode:mk_primop([Dst], fnegate, [Src])| + trans_fun(Instructions,Env)]; + _ -> + trans_fun([{arithbif,'-',Lab,[{float,0.0},SrcR],DestR}|Instructions], Env) + end; +%%-------------------------------------------------------------------- +%% New apply instructions added in April 2004 (R10B). +%%-------------------------------------------------------------------- +trans_fun([{apply,Arity}|Instructions], Env) -> + BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F + {Args,[M,F]} = lists:split(Arity,BeamArgs), + Dst = [mk_var({r,0})], + [hipe_icode:mk_comment('apply'), + hipe_icode:mk_primop(Dst, #apply_N{arity=Arity}, [M,F|Args]) + | trans_fun(Instructions,Env)]; +trans_fun([{apply_last,Arity,_N}|Instructions], Env) -> % N is StackAdjustment? + BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F + {Args,[M,F]} = lists:split(Arity,BeamArgs), + [hipe_icode:mk_comment('apply_last'), + hipe_icode:mk_enter_primop(#apply_N{arity=Arity}, [M,F|Args]) + | trans_fun(Instructions,Env)]; +%%-------------------------------------------------------------------- +%% New test instruction added in April 2004 (R10B). +%%-------------------------------------------------------------------- +%%--- is_boolean --- +trans_fun([{test,is_boolean,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(boolean,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; +%%-------------------------------------------------------------------- +%% New test instruction added in June 2005 for R11 +%%-------------------------------------------------------------------- +%%--- is_function2 --- +trans_fun([{test,is_function2,{f,Lbl},[Arg,Arity]}|Instructions], Env) -> + {Code,Env1} = trans_type_test2(function2,Lbl,Arg,Arity,Env), + [Code | trans_fun(Instructions,Env1)]; +%%-------------------------------------------------------------------- +%% New garbage-collecting BIFs added in January 2006 for R11B. +%%-------------------------------------------------------------------- +trans_fun([{gc_bif,'-',Fail,_Live,[SrcR],DstR}|Instructions], Env) -> + %% Unary minus. Change this to binary minus. + trans_fun([{arithbif,'-',Fail,[{integer,0},SrcR],DstR}|Instructions], Env); +trans_fun([{gc_bif,'+',Fail,_Live,[SrcR],DstR}|Instructions], Env) -> + %% Unary plus. Change this to a bif call. + trans_fun([{bif,'+',Fail,[SrcR],DstR}|Instructions], Env); +trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) -> + case erl_internal:guard_bif(Name, length(SrcRs)) of + false -> + %% Arithmetic instruction. + trans_fun([{arithbif,Name,Fail,SrcRs,DstR}|Instructions], Env); + true -> + %% A guard BIF. + trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env) + end; +%%-------------------------------------------------------------------- +%% Instruction for constant pool added in February 2007 for R11B-4. +%%-------------------------------------------------------------------- +trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) -> + DstV = mk_var(DstR), + Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)), + [Move | trans_fun(Instructions, Env)]; +%%-------------------------------------------------------------------- +%% New test instruction added in July 2007 for R12. +%%-------------------------------------------------------------------- +%%--- is_bitstr --- +trans_fun([{test,is_bitstr,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(bitstr, Lbl, Arg, Env), + [Code | trans_fun(Instructions, Env1)]; +%%-------------------------------------------------------------------- +%% New stack triming instruction added in October 2007 for R12. +%%-------------------------------------------------------------------- +trans_fun([{trim,N,NY}|Instructions], Env) -> + %% trim away N registers leaving NY registers + Moves = trans_trim(N, NY), + Moves ++ trans_fun(Instructions, Env); +%%-------------------------------------------------------------------- +%%--- ERROR HANDLING --- +%%-------------------------------------------------------------------- +trans_fun([X|_], _) -> + ?EXIT({'trans_fun/2',X}); +trans_fun([], _) -> + []. + +%%-------------------------------------------------------------------- +%% trans_call and trans_enter generate correct Icode calls/tail-calls, +%% recognizing explicit fails. +%%-------------------------------------------------------------------- + +trans_call(MFA={M,F,_A}, Dst, Args, Type) -> + handle_fail(MFA, Args, fun () -> hipe_icode:mk_call(Dst,M,F,Args,Type) end). + +trans_enter(MFA={M,F,_A}, Args, Type) -> + handle_fail(MFA, Args, fun () -> hipe_icode:mk_enter(M,F,Args,Type) end). + +handle_fail(MFA, Args, F) -> + case MFA of + {erlang,exit,1} -> + hipe_icode:mk_fail(Args,exit); + {erlang,throw,1} -> + hipe_icode:mk_fail(Args,throw); + {erlang,fault,1} -> + hipe_icode:mk_fail(Args,error); + {erlang,fault,2} -> + hipe_icode:mk_fail(Args,error); + {erlang,error,1} -> + hipe_icode:mk_fail(Args,error); + {erlang,error,2} -> + hipe_icode:mk_fail(Args,error); + _ -> + F() + end. + +%%----------------------------------------------------------------------- +%% trans_bif0(BifName, DestReg) +%% trans_bif(Arity, BifName, FailLab, Args, DestReg, Environment) +%%----------------------------------------------------------------------- + +trans_bif0(BifName, DestReg) -> + ?no_debug_msg(" found BIF0: ~p() ...~n", [BifName]), + BifRes = mk_var(DestReg), + hipe_icode:mk_call([BifRes],erlang,BifName,[],remote). + +trans_bif(Arity, BifName, Lbl, Args, DestReg, Env) -> + ?no_debug_msg(" found BIF: ~p(~p) ...~n", [BifName,Args]), + BifRes = mk_var(DestReg), + {Movs, SrcVars, Env1} = get_constants_in_temps(Args,Env), + case Lbl of + 0 -> % Bif is not in a guard + I = hipe_icode:mk_call([BifRes],erlang,BifName,SrcVars,remote), + {Movs ++ [I], Env1}; + _ -> % Bif occurs in a guard - fail silently to Lbl + {GuardI,Env2} = + make_fallthrough_guard([BifRes],{erlang,BifName,Arity},SrcVars, + map_label(Lbl),Env1), + {[Movs,GuardI], Env2} + end. + +trans_op_call(Name, Lbl, Args, Dests, Env, Instructions) -> + {Code, Env1} = trans_one_op_call(Name, Lbl, Args, Dests, Env), + [Code|trans_fun(Instructions, Env1)]. + +trans_one_op_call(Name, Lbl, Args, Dests, Env) -> + case Lbl of + 0 -> % Op is not in a guard + I = hipe_icode:mk_primop(Dests, Name, Args), + {[I], Env}; + _ -> % op occurs in a guard - fail silently to Lbl + make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env) + end. + +%%----------------------------------------------------------------------- +%% trans_bin_call +%%----------------------------------------------------------------------- + +trans_bin_call(Name, Lbl, Args, Dests, Base, Offset, Env, Instructions) -> + {Code, Env1} = + case Lbl of + 0 -> % Op is not in a guard + I = hipe_icode:mk_primop(Dests, Name, Args), + {[I], Env}; + _ -> % op occurs in a guard - fail silently to Lbl + make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env) + end, + [Code|trans_bin(Instructions, Base, Offset, Env1)]. + +%% Translate instructions for building binaries separately to give +%% them an appropriate state + +trans_bin([{bs_put_float,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}| + Instructions], Base, Offset, Env) -> + Flags = resolve_native_endianess(Flags0), + %% Get source + {Src,SourceInstrs,ConstInfo} = + case is_var(Source) of + true -> + {mk_var(Source),[], var}; + false -> + case Source of + {float, X} when is_float(X) -> + C = trans_const(Source), + SrcVar = mk_var(new), + I = hipe_icode:mk_move(SrcVar, C), + {SrcVar,[I],pass}; + _ -> + C = trans_const(Source), + SrcVar = mk_var(new), + I = hipe_icode:mk_move(SrcVar, C), + {SrcVar,[I],fail} + end + end, + %% Get type of put_float + {Name,Args,Env2} = + case Size of + {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> + %% Create a N*Unit bits float + {{bs_put_float, NoBits*Unit, Flags, ConstInfo}, [Src, Base, Offset], Env}; + {integer,NoBits} when is_integer(NoBits), NoBits < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + BitReg -> % Use a number of bits only known at runtime. + Bits = mk_var(BitReg), + {{bs_put_float, Unit, Flags, ConstInfo}, [Src,Bits,Base,Offset], Env} + end, + %% Generate code for calling the bs-op. + SourceInstrs ++ + trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Offset], Base, Offset, Env2, Instructions); +trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| + Instructions], Base, Offset, Env) -> + %% Get the source of the binary. + Src = trans_arg(Source), + %% Get type of put_binary + {Name, Args, Env2} = + case Size of + {atom,all} -> %% put all bits + {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> + %% Create a N*Unit bits subbinary + {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; + {integer,NoBits} when is_integer(NoBits), NoBits < 0 -> + ?EXIT({bad_bs_size_constant,Size}); + BitReg -> % Use a number of bits only known at runtime. + Bits = mk_var(BitReg), + {{bs_put_binary, Unit, Flags}, [Src, Bits,Base,Offset], Env} + end, + %% Generate code for calling the bs-op. + trans_bin_call({hipe_bs_primop, Name}, + Lbl, Args, [Offset], + Base, Offset, Env2, Instructions); +%%--- bs_put_string --- +trans_bin([{bs_put_string,SizeInBytes,{string,String}}|Instructions], Base, + Offset, Env) -> + [hipe_icode:mk_primop([Offset], + {hipe_bs_primop,{bs_put_string, String, SizeInBytes}}, + [Base, Offset]) | + trans_bin(Instructions, Base, Offset, Env)]; +trans_bin([{bs_put_integer,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}| + Instructions], Base, Offset, Env) -> + Flags = resolve_native_endianess(Flags0), + %% Get size-type + + %% Get the source of the binary. + {Src, SrcInstrs, ConstInfo} = + case is_var(Source) of + true -> + {mk_var(Source), [], var}; + false -> + case Source of + {integer, X} when is_integer(X) -> + C = trans_const(Source), + SrcVar = mk_var(new), + I = hipe_icode:mk_move(SrcVar, C), + {SrcVar,[I], pass}; + _ -> + C = trans_const(Source), + SrcVar = mk_var(new), + I = hipe_icode:mk_move(SrcVar, C), + {SrcVar,[I], fail} + + end + end, + {Name, Args, Env2} = + case is_var(Size) of + true -> + SVar = mk_var(Size), + {{bs_put_integer,Unit,Flags,ConstInfo}, [SVar, Base, Offset], Env}; + false -> + case Size of + {integer, NoBits} when NoBits >= 0 -> + {{bs_put_integer,NoBits*Unit,Flags,ConstInfo}, [Base, Offset], Env}; + _ -> + ?EXIT({bad_bs_size_constant,Size}) + end + end, + SrcInstrs ++ trans_bin_call({hipe_bs_primop, Name}, + Lbl, [Src|Args], [Offset], Base, Offset, Env2, Instructions); +%%---------------------------------------------------------------- +%% New binary construction instructions added in R12B-5 (Fall 2008). +%%---------------------------------------------------------------- +trans_bin([{bs_put_utf8,{f,Lbl},_FF,A3}|Instructions], Base, Offset, Env) -> + Src = trans_arg(A3), + Args = [Src, Base, Offset], + trans_bin_call({hipe_bs_primop, bs_put_utf8}, Lbl, Args, [Offset], Base, Offset, Env, Instructions); +trans_bin([{bs_put_utf16,{f,Lbl},{field_flags,Flags0},A3}|Instructions], Base, Offset, Env) -> + Src = trans_arg(A3), + Args = [Src, Base, Offset], + Flags = resolve_native_endianess(Flags0), + Name = {bs_put_utf16, Flags}, + trans_bin_call({hipe_bs_primop, Name}, Lbl, Args, [Offset], Base, Offset, Env, Instructions); +trans_bin([{bs_put_utf32,F={f,Lbl},FF={field_flags,_Flags0},A3}|Instructions], Base, Offset, Env) -> + Src = trans_arg(A3), + trans_bin_call({hipe_bs_primop,bs_validate_unicode}, Lbl, [Src], [], Base, Offset, Env, + [{bs_put_integer,F,{integer,32},1,FF,A3} | Instructions]); +%%---------------------------------------------------------------- +%% Base cases for the end of a binary construction sequence. +%%---------------------------------------------------------------- +trans_bin([{bs_final2,Src,Dst}|Instructions], _Base, Offset, Env) -> + [hipe_icode:mk_primop([mk_var(Dst)], {hipe_bs_primop, bs_final}, + [trans_arg(Src),Offset]) + |trans_fun(Instructions, Env)]; +trans_bin(Instructions, _Base, _Offset, Env) -> + trans_fun(Instructions, Env). + +%% this translates bs_get_utf8 and bs_skip_utf8 (get with new unused dst) +trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env) -> + Dst = mk_var(X), + MsVar = mk_var(Ms), + trans_op_call({hipe_bs_primop,bs_get_utf8}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions). + +%% this translates bs_get_utf16 and bs_skip_utf16 (get with new unused dst) +trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env) -> + Dst = mk_var(X), + MsVar = mk_var(Ms), + Flags = resolve_native_endianess(Flags0), + Name = {bs_get_utf16,Flags}, + trans_op_call({hipe_bs_primop,Name}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions). + +%% this translates bs_get_utf32 and bs_skip_utf32 (get with new unused dst) +trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env) -> + Dst = mk_var(X), + MsVar = mk_var(Ms), + Flags = resolve_native_endianess(Flags0), + {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,32,Flags}}, + Lbl, [MsVar], [Dst,MsVar], Env), + I1 ++ trans_op_call({hipe_bs_primop,bs_validate_unicode_retract}, + Lbl, [Dst,MsVar], [MsVar], Env1, Instructions). + +%%----------------------------------------------------------------------- +%% trans_arith(Op, SrcVars, Des, Lab, Env) -> { Icode, NewEnv } +%% A failure label of type {f,0} means in a body. +%% A failure label of type {f,L} where L>0 means in a guard. +%% Within a guard a failure should branch to the next guard and +%% not trigger an exception!! +%% Handles body arithmetic with Icode primops! +%% Handles guard arithmetic with Icode guardops! +%%----------------------------------------------------------------------- + +trans_arith(Op, SrcRs, DstR, Lbl, Env) -> + {Movs,SrcVars,Env1} = get_constants_in_temps(SrcRs,Env), + DstVar = mk_var(DstR), + %%io:format("~w:trans_arith()\n ~w := ~w ~w\n", + %% [?MODULE,DstVar,SrcVars,Op]), + case Lbl of + 0 -> % Body arithmetic + Primop = hipe_icode:mk_primop([DstVar], arith_op_name(Op), SrcVars), + {Movs++[Primop], Env1}; + _ -> % Guard arithmetic + {Guard,Env2} = + make_fallthrough_guard([DstVar], arith_op_name(Op), SrcVars, + map_label(Lbl), Env1), + {[Movs,Guard], Env2} + end. + +%% Prevent arbitrary names from leaking into Icode from BEAM. +arith_op_name('+') -> '+'; +arith_op_name('-') -> '-'; +arith_op_name('*') -> '*'; +arith_op_name('/') -> '/'; +arith_op_name('div') -> 'div'; +arith_op_name('fp_add') -> 'fp_add'; +arith_op_name('fp_sub') -> 'fp_sub'; +arith_op_name('fp_mul') -> 'fp_mul'; +arith_op_name('fp_div') -> 'fp_div'; +arith_op_name('rem') -> 'rem'; +arith_op_name('bsl') -> 'bsl'; +arith_op_name('bsr') -> 'bsr'; +arith_op_name('band') -> 'band'; +arith_op_name('bor') -> 'bor'; +arith_op_name('bxor') -> 'bxor'; +arith_op_name('bnot') -> 'bnot'. + +%%----------------------------------------------------------------------- +%%----------------------------------------------------------------------- + +trans_test_guard(TestOp,F,Arg1,Arg2,Env) -> + {Movs,Vars,Env1} = get_constants_in_temps([Arg1,Arg2],Env), + True = mk_label(new), + I = hipe_icode:mk_if(TestOp,Vars,hipe_icode:label_name(True),map_label(F)), + {[Movs,I,True], Env1}. + +%%----------------------------------------------------------------------- +%%----------------------------------------------------------------------- + +make_fallthrough_guard(DstVar,GuardOp,Args,FailLName,Env) -> + ContL = mk_label(new), + ContLName = hipe_icode:label_name(ContL), + {Instrs, NewDsts} = clone_dsts(DstVar), + {Guard,Env1} = make_guard(NewDsts,GuardOp,Args,ContLName,FailLName,Env), + {[Guard,ContL]++Instrs,Env1}. + +%% Make sure DstVar gets initialised to a dummy value after a fail: +%make_guard(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName,Env) -> +% {[hipe_icode:mk_guardop(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName)], +% Env}; +make_guard(Dests=[_|_],GuardOp,Args,ContLName,FailLName,Env) -> + TmpFailL = mk_label(new), + TmpFailLName = hipe_icode:label_name(TmpFailL), + GuardOpIns = hipe_icode:mk_guardop(Dests,GuardOp,Args, + ContLName,TmpFailLName), + FailCode = [TmpFailL, + nillify_all(Dests), + hipe_icode:mk_goto(FailLName)], + {[GuardOpIns|FailCode], Env}; +%% A guard that does not return anything: +make_guard([],GuardOp,Args,ContLName,FailLName,Env) -> + {[hipe_icode:mk_guardop([],GuardOp,Args,ContLName,FailLName)], + Env}. + +nillify_all([Var|Vars]) -> + [hipe_icode:mk_move(Var,hipe_icode:mk_const([]))|nillify_all(Vars)]; +nillify_all([]) -> []. + +clone_dsts(Dests) -> + clone_dsts(Dests, [],[]). + +clone_dsts([Dest|Dests], Instrs, NewDests) -> + {I,ND} = clone_dst(Dest), + clone_dsts(Dests, [I|Instrs], [ND|NewDests]); +clone_dsts([], Instrs, NewDests) -> + {lists:reverse(Instrs), lists:reverse(NewDests)}. + +clone_dst(Dest) -> + New = + case hipe_icode:is_reg(Dest) of + true -> + mk_var(reg); + false -> + true = hipe_icode:is_var(Dest), + mk_var(new) + end, + {hipe_icode:mk_move(Dest, New), New}. + + +%%----------------------------------------------------------------------- +%% trans_type_test(Test, Lbl, Arg, Env) -> { Icode, NewEnv } +%% Handles all unary type tests like is_integer etc. +%%----------------------------------------------------------------------- + +trans_type_test(Test, Lbl, Arg, Env) -> + True = mk_label(new), + {Move,Var,Env1} = mk_move_and_var(Arg,Env), + I = hipe_icode:mk_type([Var], Test, + hipe_icode:label_name(True), map_label(Lbl)), + {[Move,I,True],Env1}. + +%% +%% This handles binary type tests. Currently, the only such is the new +%% is_function/2 BIF. +%% +trans_type_test2(function2, Lbl, Arg, Arity, Env) -> + True = mk_label(new), + {Move1,Var1,Env1} = mk_move_and_var(Arg, Env), + {Move2,Var2,Env2} = mk_move_and_var(Arity, Env1), + I = hipe_icode:mk_type([Var1,Var2], function2, + hipe_icode:label_name(True), map_label(Lbl)), + {[Move1,Move2,I,True],Env2}. + +%%----------------------------------------------------------------------- +%% trans_puts(Code, Environment) -> +%% { Movs, Code, Vars, NewEnv } +%%----------------------------------------------------------------------- + +trans_puts(Code, Env) -> + trans_puts(Code, [], [], Env). + +trans_puts([{put,X}|Code], Vars, Moves, Env) -> + case type(X) of + var -> + Var = mk_var(X), + trans_puts(Code, [Var|Vars], Moves, Env); + #beam_const{value=C} -> + Var = mk_var(new), + Move = hipe_icode:mk_move(Var, hipe_icode:mk_const(C)), + trans_puts(Code, [Var|Vars], [Move|Moves], Env) + end; +trans_puts(Code, Vars, Moves, Env) -> %% No more put operations + {Moves, Code, Vars, Env}. + +%%----------------------------------------------------------------------- +%% The code for this instruction is a bit large because we are treating +%% different cases differently. We want to use the icode `type' +%% instruction when it is applicable to take care of match expressions. +%%----------------------------------------------------------------------- + +trans_is_eq_exact(Lbl, Arg1, Arg2, Env) -> + case {is_var(Arg1),is_var(Arg2)} of + {true,true} -> + True = mk_label(new), + I = hipe_icode:mk_if('=:=', + [mk_var(Arg1),mk_var(Arg2)], + hipe_icode:label_name(True), map_label(Lbl)), + {[I,True], Env}; + {true,false} -> %% right argument is a constant -- use type()! + trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env); + {false,true} -> %% mirror of the case above; swap args + trans_is_eq_exact_var_const(Lbl, Arg2, Arg1, Env); + {false,false} -> %% both arguments are constants !!! + case Arg1 =:= Arg2 of + true -> + {[], Env}; + false -> + Never = mk_label(new), + I = hipe_icode:mk_goto(map_label(Lbl)), + {[I,Never], Env} + end + end. + +trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =:= const + True = mk_label(new), + NewArg1 = mk_var(Arg1), + TrueLabName = hipe_icode:label_name(True), + FalseLabName = map_label(Lbl), + I = case Arg2 of + {float,Float} -> + hipe_icode:mk_if('=:=', + [NewArg1, hipe_icode:mk_const(Float)], + TrueLabName, FalseLabName); + {literal,Literal} -> + hipe_icode:mk_if('=:=', + [NewArg1, hipe_icode:mk_const(Literal)], + TrueLabName, FalseLabName); + _ -> + hipe_icode:mk_type([NewArg1], Arg2, TrueLabName, FalseLabName) + end, + {[I,True], Env}. + +%%----------------------------------------------------------------------- +%% ... and this is analogous to the above +%%----------------------------------------------------------------------- + +trans_is_ne_exact(Lbl, Arg1, Arg2, Env) -> + case {is_var(Arg1),is_var(Arg2)} of + {true,true} -> + True = mk_label(new), + I = hipe_icode:mk_if('=/=', + [mk_var(Arg1),mk_var(Arg2)], + hipe_icode:label_name(True), map_label(Lbl)), + {[I,True], Env}; + {true,false} -> %% right argument is a constant -- use type()! + trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env); + {false,true} -> %% mirror of the case above; swap args + trans_is_ne_exact_var_const(Lbl, Arg2, Arg1, Env); + {false,false} -> %% both arguments are constants !!! + case Arg1 =/= Arg2 of + true -> + {[], Env}; + false -> + Never = mk_label(new), + I = hipe_icode:mk_goto(map_label(Lbl)), + {[I,Never], Env} + end + end. + +trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =/= const + True = mk_label(new), + NewArg1 = mk_var(Arg1), + TrueLabName = hipe_icode:label_name(True), + FalseLabName = map_label(Lbl), + I = case Arg2 of + {float,Float} -> + hipe_icode:mk_if('=/=', + [NewArg1, hipe_icode:mk_const(Float)], + TrueLabName, FalseLabName); + {literal,Literal} -> + hipe_icode:mk_if('=/=', + [NewArg1, hipe_icode:mk_const(Literal)], + TrueLabName, FalseLabName); + _ -> + hipe_icode:mk_type([NewArg1], Arg2, FalseLabName, TrueLabName) + end, + {[I,True], Env}. + +%%----------------------------------------------------------------------- +%% Try to do a relatively straightforward optimization: if equality with +%% an atom is used, then convert this test to use of exact equality test +%% with the same atom (which in turn will be translated to a `type' test +%% instruction by the code of trans_is_eq_exact_var_const/4 above). +%%----------------------------------------------------------------------- + +trans_is_eq(Lbl, Arg1, Arg2, Env) -> + case {is_var(Arg1),is_var(Arg2)} of + {true,true} -> %% not much can be done in this case + trans_test_guard('==', Lbl, Arg1, Arg2, Env); + {true,false} -> %% optimize this case, if possible + case Arg2 of + {atom,_SomeAtom} -> + trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env); + _ -> + trans_test_guard('==', Lbl, Arg1, Arg2, Env) + end; + {false,true} -> %% probably happens rarely; hence the recursive call + trans_is_eq(Lbl, Arg2, Arg1, Env); + {false,false} -> %% both arguments are constants !!! + case Arg1 == Arg2 of + true -> + {[], Env}; + false -> + Never = mk_label(new), + I = hipe_icode:mk_goto(map_label(Lbl)), + {[I,Never], Env} + end + end. + +%%----------------------------------------------------------------------- +%% ... and this is analogous to the above +%%----------------------------------------------------------------------- + +trans_is_ne(Lbl, Arg1, Arg2, Env) -> + case {is_var(Arg1),is_var(Arg2)} of + {true,true} -> %% not much can be done in this case + trans_test_guard('/=', Lbl, Arg1, Arg2, Env); + {true,false} -> %% optimize this case, if possible + case Arg2 of + {atom,_SomeAtom} -> + trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env); + _ -> + trans_test_guard('/=', Lbl, Arg1, Arg2, Env) + end; + {false,true} -> %% probably happens rarely; hence the recursive call + trans_is_ne(Lbl, Arg2, Arg1, Env); + {false,false} -> %% both arguments are constants !!! + case Arg1 /= Arg2 of + true -> + {[], Env}; + false -> + Never = mk_label(new), + I = hipe_icode:mk_goto(map_label(Lbl)), + {[I,Never], Env} + end + end. + + +%%----------------------------------------------------------------------- +%% Translates an allocate instruction into a sequence of initializations +%%----------------------------------------------------------------------- + +trans_allocate(N) -> + trans_allocate(N, []). + +trans_allocate(0, Acc) -> + Acc; +trans_allocate(N, Acc) -> + Move = hipe_icode:mk_move(mk_var({y,N-1}), + hipe_icode:mk_const('dummy_value')), + trans_allocate(N-1, [Move|Acc]). + +%%----------------------------------------------------------------------- +%% Translates a trim instruction into a sequence of moves +%%----------------------------------------------------------------------- + +trans_trim(N, NY) -> + lists:reverse(trans_trim(N, NY, 0, [])). + +trans_trim(_, 0, _, Acc) -> + Acc; +trans_trim(N, NY, Y, Acc) -> + Move = hipe_icode:mk_move(mk_var({y,Y}), mk_var({y,N})), + trans_trim(N+1, NY-1, Y+1, [Move|Acc]). + +%%----------------------------------------------------------------------- +%%----------------------------------------------------------------------- + +mk_move_and_var(Var, Env) -> + case type(Var) of + var -> + V = mk_var(Var), + {[], V, Env}; + #beam_const{value=C} -> + V = mk_var(new), + {[hipe_icode:mk_move(V,hipe_icode:mk_const(C))], V, Env} + end. + +%%----------------------------------------------------------------------- +%% Find names of closures and number of free vars. +%%----------------------------------------------------------------------- + +closure_info_mfa(#closure_info{mfa=MFA}) -> MFA. +closure_info_arity(#closure_info{arity=Arity}) -> Arity. +%% closure_info_fv_arity(#closure_info{fv_arity=Arity}) -> Arity. + +find_closure_info(Code) -> mod_find_closure_info(Code, []). + +mod_find_closure_info([FunCode|Fs], CI) -> + mod_find_closure_info(Fs, find_closure_info(FunCode, CI)); +mod_find_closure_info([], CI) -> + CI. + +find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode], + ClosureInfo) -> + NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure) + #closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum}, + find_closure_info(BeamCode, [NewClosure|ClosureInfo]); +find_closure_info([_Inst|BeamCode], ClosureInfo) -> + find_closure_info(BeamCode, ClosureInfo); +find_closure_info([], ClosureInfo) -> + ClosureInfo. + +%%----------------------------------------------------------------------- +%% Is closure +%%----------------------------------------------------------------------- + +get_closure_info(MFA, [CI|Rest]) -> + case closure_info_mfa(CI) of + MFA -> CI; + _ -> get_closure_info(MFA, Rest) + end; +get_closure_info(_, []) -> + not_a_closure. + +%%----------------------------------------------------------------------- +%% Patch closure entry. +%%----------------------------------------------------------------------- + +%% NOTE: this changes the number of parameters in the ICode function, +%% but does *not* change the arity in the function name. Thus, all +%% closure-functions have the exact same names in Beam and in native +%% code, although they have different calling conventions. + +patch_closure_entry(Icode, ClosureInfo)-> + Arity = closure_info_arity(ClosureInfo), + %% ?msg("Arity ~w\n",[Arity]), + {Args, Closure, FreeVars} = + split_params(Arity, hipe_icode:icode_params(Icode), []), + [Start|_] = hipe_icode:icode_code(Icode), + {_LMin, LMax} = hipe_icode:icode_label_range(Icode), + hipe_gensym:set_label(icode,LMax+1), + {_VMin, VMax} = hipe_icode:icode_var_range(Icode), + hipe_gensym:set_var(icode,VMax+1), + MoveCode = gen_get_free_vars(FreeVars, Closure, + hipe_icode:label_name(Start)), + Icode1 = hipe_icode:icode_code_update(Icode, MoveCode ++ + hipe_icode:icode_code(Icode)), + Icode2 = hipe_icode:icode_params_update(Icode1, Args), + %% Arity - 1 since the original arity did not have the closure argument. + Icode3 = hipe_icode:icode_closure_arity_update(Icode2, Arity-1), + Icode3. + +%%----------------------------------------------------------------------- + +gen_get_free_vars(Vars, Closure, StartName) -> + [hipe_icode:mk_new_label()] ++ + get_free_vars(Vars, Closure, 1, []) ++ [hipe_icode:mk_goto(StartName)]. + +get_free_vars([V|Vs], Closure, No, MoveCode) -> + %% TempV = hipe_icode:mk_new_var(), + get_free_vars(Vs, Closure, No+1, + [%% hipe_icode:mk_move(TempV,hipe_icode:mk_const(No)), + hipe_icode:mk_primop([V], #closure_element{n=No}, [Closure]) + |MoveCode]); +get_free_vars([],_,_,MoveCode) -> + MoveCode. + +%%----------------------------------------------------------------------- + +split_params(1, [Closure|_OrgArgs] = Params, Args) -> + {lists:reverse([Closure|Args]), Closure, Params}; +split_params(1, [], Args) -> + Closure = hipe_icode:mk_new_var(), + {lists:reverse([Closure|Args]), Closure, []}; +split_params(N, [ArgN|OrgArgs], Args) -> + split_params(N-1, OrgArgs, [ArgN|Args]). + +%%----------------------------------------------------------------------- + +preprocess_code(ModuleCode) -> + PatchedCode = patch_R7_funs(ModuleCode), + ClosureInfo = find_closure_info(PatchedCode), + {PatchedCode, ClosureInfo}. + +%%----------------------------------------------------------------------- +%% Patches the "make_fun" BEAM instructions of R7 so that they also +%% contain the index that the BEAM loader generates for funs. +%% +%% The index starts from 0 and is incremented by 1 for each make_fun +%% instruction encountered. +%% +%% Retained only for compatibility with BEAM code prior to R8. +%% +%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2" +%% instructions, since their embedded indices don't work. +%%----------------------------------------------------------------------- + +patch_R7_funs(ModuleCode) -> + patch_make_funs(ModuleCode, 0). + +patch_make_funs([FunCode0|Fs], FunIndex0) -> + {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []), + [PatchedFunCode|patch_make_funs(Fs, FunIndex)]; +patch_make_funs([], _) -> []. + +patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) -> + Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, + patch_make_funs(Is, FunIndex+1, [Patched|Acc]); +patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) -> + Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, + patch_make_funs(Is, FunIndex+1, [Patched|Acc]); +patch_make_funs([I|Is], FunIndex, Acc) -> + patch_make_funs(Is, FunIndex, [I|Acc]); +patch_make_funs([], FunIndex, Acc) -> + {lists:reverse(Acc),FunIndex}. + +%%----------------------------------------------------------------------- + +find_mfa([{label,_}|Code]) -> + find_mfa(Code); +find_mfa([{func_info,{atom,M},{atom,F},A}|_]) + when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> + {M, F, A}. + +%%----------------------------------------------------------------------- + +%% Localize a particular function in a module +get_fun([[L, {func_info,{atom,M},{atom,F},A} | Is] | _], M,F,A) -> + [L, {func_info,{atom,M},{atom,F},A} | Is]; +get_fun([[_L1,_L2, {func_info,{atom,M},{atom,F},A} = MFA| _Is] | _], M,F,A) -> + ?WARNING_MSG("Consecutive labels found; please re-create the .beam file~n", []), + [_L1,_L2, MFA | _Is]; +get_fun([_|Rest], M,F,A) -> + get_fun(Rest, M,F,A). + +%%----------------------------------------------------------------------- +%% Takes a list of arguments and returns the constants of them into +%% fresh temporaries. Return a triple consisting of a list of move +%% instructions, a list of proper icode arguments and the new environment. +%%----------------------------------------------------------------------- + +get_constants_in_temps(Args, Env) -> + get_constants_in_temps(Args, [], [], Env). + +get_constants_in_temps([Arg|Args], Instrs, Temps, Env) -> + case get_constant_in_temp(Arg, Env) of + {none,ArgVar,Env1} -> + get_constants_in_temps(Args, Instrs, [ArgVar|Temps], Env1); + {Instr,Temp,Env1} -> + get_constants_in_temps(Args, [Instr|Instrs], [Temp|Temps], Env1) + end; +get_constants_in_temps([], Instrs, Temps, Env) -> + {lists:reverse(Instrs), lists:reverse(Temps), Env}. + +%% If Arg is a constant then put Arg in a fresh temp! +get_constant_in_temp(Arg, Env) -> + case is_var(Arg) of + true -> % Convert into Icode variable format before return + {none, mk_var(Arg), Env}; + false -> % Create a new temp and move the constant into it + Temp = mk_var(new), + Const = trans_const(Arg), + {hipe_icode:mk_move(Temp, Const), Temp, Env} + end. + +%%----------------------------------------------------------------------- +%% Makes a list of function arguments. +%%----------------------------------------------------------------------- + +extract_fun_args(A) -> + lists:reverse(extract_fun_args1(A)). + +extract_fun_args1(0) -> + []; +extract_fun_args1(1) -> + [mk_var({r,0})]; +extract_fun_args1(N) -> + [mk_var({x,N-1}) | extract_fun_args1(N-1)]. + +%%----------------------------------------------------------------------- +%% Auxiliary translation for arguments of select_val & select_tuple_arity +%%----------------------------------------------------------------------- + +trans_select_stuff(Reg, CaseList) -> + SwVar = case is_var(Reg) of + true -> + mk_var(Reg); + false -> + trans_const(Reg) + end, + CasePairs = trans_case_list(CaseList), + {SwVar,CasePairs}. + +trans_case_list([Symbol,{f,Lbl}|L]) -> + [{trans_const(Symbol),map_label(Lbl)} | trans_case_list(L)]; +trans_case_list([]) -> + []. + +%%----------------------------------------------------------------------- +%% Makes an Icode argument from a BEAM argument. +%%----------------------------------------------------------------------- + +trans_arg(Arg) -> + case is_var(Arg) of + true -> + mk_var(Arg); + false -> + trans_const(Arg) + end. + +%%----------------------------------------------------------------------- +%% Makes an Icode constant from a BEAM constant. +%%----------------------------------------------------------------------- + +trans_const(Const) -> + case Const of + {atom,Atom} when is_atom(Atom) -> + hipe_icode:mk_const(Atom); + {integer,N} when is_integer(N) -> + hipe_icode:mk_const(N); + {float,Float} when is_float(Float) -> + hipe_icode:mk_const(Float); + {string,String} -> + hipe_icode:mk_const(String); + {literal,Literal} -> + hipe_icode:mk_const(Literal); + nil -> + hipe_icode:mk_const([]); + Int when is_integer(Int) -> + hipe_icode:mk_const(Int) + end. + +%%----------------------------------------------------------------------- +%% Make an icode variable of proper type +%% (Variables mod 5) =:= 0 are X regs +%% (Variables mod 5) =:= 1 are Y regs +%% (Variables mod 5) =:= 2 are FR regs +%% (Variables mod 5) =:= 3 are new temporaries +%% (Variables mod 5) =:= 4 are new register temporaries +%% Tell hipe_gensym to update its state for each new thing created!! +%%----------------------------------------------------------------------- + +mk_var({r,0}) -> + hipe_icode:mk_var(0); +mk_var({x,R}) when is_integer(R) -> + V = 5*R, + hipe_gensym:update_vrange(icode,V), + hipe_icode:mk_var(V); +mk_var({y,R}) when is_integer(R) -> + V = (5*R)+1, + hipe_gensym:update_vrange(icode,V), + hipe_icode:mk_var(V); +mk_var({fr,R}) when is_integer(R) -> + V = (5*R)+2, + hipe_gensym:update_vrange(icode,V), + case get(hipe_inline_fp) of + true -> + hipe_icode:mk_fvar(V); + _ -> + hipe_icode:mk_var(V) + end; +mk_var(new) -> + T = hipe_gensym:new_var(icode), + V = (5*T)+3, + hipe_gensym:update_vrange(icode,V), + hipe_icode:mk_var(V); +mk_var(reg) -> + T = hipe_gensym:new_var(icode), + V = (5*T)+4, + hipe_gensym:update_vrange(icode,V), + hipe_icode:mk_reg(V). + +%%----------------------------------------------------------------------- +%% Make an icode label of proper type +%% (Labels mod 2) =:= 0 are actually occuring in the BEAM code +%% (Labels mod 2) =:= 1 are new labels generated by the translation +%%----------------------------------------------------------------------- + +mk_label(L) when is_integer(L) -> + LL = 2 * L, + hipe_gensym:update_lblrange(icode, LL), + hipe_icode:mk_label(LL); +mk_label(new) -> + L = hipe_gensym:new_label(icode), + LL = (2 * L) + 1, + hipe_gensym:update_lblrange(icode, LL), + hipe_icode:mk_label(LL). + +%% Maps from the BEAM's labelling scheme to our labelling scheme. +%% See mk_label to understand how it works. + +map_label(L) -> + L bsl 1. % faster and more type-friendly version of 2 * L + +%%----------------------------------------------------------------------- +%% Returns the type of the given variables. +%%----------------------------------------------------------------------- + +type({x,_}) -> + var; +type({y,_}) -> + var; +type({fr,_}) -> + var; +type({atom,A}) when is_atom(A) -> + #beam_const{value=A}; +type(nil) -> + #beam_const{value=[]}; +type({integer,X}) when is_integer(X) -> + #beam_const{value=X}; +type({float,X}) when is_float(X) -> + #beam_const{value=X}; +type({literal,X}) -> + #beam_const{value=X}. + +%%----------------------------------------------------------------------- +%% Returns true iff the argument is a variable. +%%----------------------------------------------------------------------- + +is_var({x,_}) -> + true; +is_var({y,_}) -> + true; +is_var({fr,_}) -> + true; +is_var({atom,A}) when is_atom(A) -> + false; +is_var(nil) -> + false; +is_var({integer,N}) when is_integer(N) -> + false; +is_var({float,F}) when is_float(F) -> + false; +is_var({literal,_Literal}) -> + false. + +%%----------------------------------------------------------------------- +%% Fixes the code for catches by adding some code. +%%----------------------------------------------------------------------- + +fix_catches(Code) -> + fix_catches(Code, gb_trees:empty()). + +%% We need to handle merged catch blocks, that is multiple 'catch' with +%% only one 'catch_end', or multiple 'try' with one 'try_case'. (Catch +%% and try can never be merged.) All occurrences of 'catch' or 'try' +%% with a particular fail-to label are assumed to only occur before the +%% corresponding 'catch_end'/'try_end' in the Beam code. + +fix_catches([{'catch',N,Lbl},ContLbl|Code], HandledCatchLbls) -> + fix_catch('catch',Lbl,ContLbl,Code,HandledCatchLbls,{catch_end,N}); +fix_catches([{'try',N,Lbl},ContLbl|Code], HandledCatchLbls) -> + fix_catch('try',Lbl,ContLbl,Code,HandledCatchLbls,{try_case,N}); +fix_catches([Instr|Code], HandledCatchLbls) -> + [Instr|fix_catches(Code, HandledCatchLbls)]; +fix_catches([], _HandledCatchLbls) -> + []. + +fix_catch(Type, Lbl, ContLbl, Code, HandledCatchLbls, Instr) -> + TLbl = {Type, Lbl}, + case gb_trees:lookup(TLbl, HandledCatchLbls) of + {value, Catch} when is_integer(Catch) -> + NewCode = fix_catches(Code, HandledCatchLbls), + Cont = hipe_icode:label_name(ContLbl), + [hipe_icode:mk_begin_try(Catch,Cont),ContLbl | NewCode]; + none -> + OldCatch = map_label(Lbl), + OldCatchLbl = hipe_icode:mk_label(OldCatch), + {CodeToCatch,RestOfCode} = split_code(Code,OldCatchLbl,Instr), + NewCatchLbl = mk_label(new), + NewCatch = hipe_icode:label_name(NewCatchLbl), + %% The rest of the code cannot contain catches with the same label. + RestOfCode1 = fix_catches(RestOfCode, HandledCatchLbls), + %% The catched code *can* contain more catches with the same label. + NewHandledCatchLbls = gb_trees:insert(TLbl, NewCatch, HandledCatchLbls), + CatchedCode = fix_catches(CodeToCatch, NewHandledCatchLbls), + %% The variables which will get the tag, value, and trace. + Vars = [mk_var({r,0}), mk_var({x,1}), mk_var({x,2})], + Cont = hipe_icode:label_name(ContLbl), + [hipe_icode:mk_begin_try(NewCatch,Cont), ContLbl] + ++ CatchedCode + ++ [mk_label(new), % dummy label before the goto + hipe_icode:mk_goto(OldCatch), % normal execution path + NewCatchLbl, % exception handing enters here + hipe_icode:mk_begin_handler(Vars)] + ++ catch_handler(Type, Vars, OldCatchLbl) + ++ RestOfCode1 % back to normal execution + end. + +catch_handler('try', _Vars, OldCatchLbl) -> + %% A try just falls through to the old fail-to label which marked the + %% start of the try_case block. All variables are set up as expected. + [OldCatchLbl]; +catch_handler('catch', [TagVar,ValueVar,TraceVar], OldCatchLbl) -> + %% This basically implements a catch as a try-expression. We must jump + %% to the given end label afterwards so we don't pass through both the + %% begin_handler and the end_try. + ContLbl = mk_label(new), + Cont = hipe_icode:label_name(ContLbl), + ThrowLbl = mk_label(new), + NoThrowLbl = mk_label(new), + ExitLbl = mk_label(new), + ErrorLbl = mk_label(new), + Dst = mk_var({r,0}), + [hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('throw')], + hipe_icode:label_name(ThrowLbl), + hipe_icode:label_name(NoThrowLbl)), + ThrowLbl, + hipe_icode:mk_move(Dst, ValueVar), + hipe_icode:mk_goto(Cont), + NoThrowLbl, + hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('exit')], + hipe_icode:label_name(ExitLbl), + hipe_icode:label_name(ErrorLbl)), + ExitLbl, + hipe_icode:mk_primop([Dst],mktuple,[hipe_icode:mk_const('EXIT'), + ValueVar]), + hipe_icode:mk_goto(Cont), + ErrorLbl, + %% We use the trace variable to hold the symbolic trace. Its previous + %% value is just that in p->ftrace, so get_stacktrace() works fine. + hipe_icode:mk_call([TraceVar],erlang,get_stacktrace,[],remote), + hipe_icode:mk_primop([ValueVar],mktuple, [ValueVar, TraceVar]), + hipe_icode:mk_goto(hipe_icode:label_name(ExitLbl)), + OldCatchLbl, % normal execution paths must go through end_try + hipe_icode:mk_end_try(), + hipe_icode:mk_goto(Cont), + ContLbl]. + +%% Note that it is the fail-to label that is the important thing, but +%% for 'catch' we want to make sure that the label is followed by the +%% 'catch_end' instruction - if it is not, we might have a real problem. +%% Checking that a 'try' label is followed by 'try_case' is not as +%% important, but we get that as a bonus. + +split_code([First|Code], Label, Instr) -> + split_code(Code, Label, Instr, First, []). + +split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label -> + split_code_final(Code, As); % drop both label and instruction +split_code([Other|_Code], Label, Instr, Prev, _As) when Prev =:= Label -> + ?EXIT({missing_instr_after_label, Label, Instr, [Other, Prev | _As]}); +split_code([Other|Code], Label, Instr, Prev, As) -> + split_code(Code, Label, Instr, Other, [Prev|As]); +split_code([], _Label, _Instr, Prev, As) -> + split_code_final([], [Prev|As]). + +split_code_final(Code, As) -> + {lists:reverse(As), Code}. + +%%----------------------------------------------------------------------- +%% Fixes fallthroughs +%%----------------------------------------------------------------------- + +fix_fallthroughs([]) -> + []; +fix_fallthroughs([I|Is]) -> + fix_fallthroughs(Is, I, []). + +fix_fallthroughs([I1|Is], I0, Acc) -> + case hipe_icode:is_label(I1) of + false -> + fix_fallthroughs(Is, I1, [I0 | Acc]); + true -> + case hipe_icode:is_branch(I0) of + true -> + fix_fallthroughs(Is, I1, [I0 | Acc]); + false -> + %% non-branch before label - insert a goto + Goto = hipe_icode:mk_goto(hipe_icode:label_name(I1)), + fix_fallthroughs(Is, I1, [Goto, I0 | Acc]) + end + end; +fix_fallthroughs([], I, Acc) -> + lists:reverse([I | Acc]). + +%%----------------------------------------------------------------------- +%% Removes the code between a fail instruction and the closest following +%% label. +%%----------------------------------------------------------------------- + +-spec remove_dead_code(icode_instrs()) -> icode_instrs(). +remove_dead_code([I|Is]) -> + case I of + #icode_fail{} -> + [I|remove_dead_code(skip_to_label(Is))]; + _ -> + [I|remove_dead_code(Is)] + end; +remove_dead_code([]) -> + []. + +%% returns the instructions from the closest label +-spec skip_to_label(icode_instrs()) -> icode_instrs(). +skip_to_label([I|Is] = Instrs) -> + case I of + #icode_label{} -> Instrs; + _ -> skip_to_label(Is) + end; +skip_to_label([]) -> + []. + +%%----------------------------------------------------------------------- +%% This needs to be extended in case new architectures are added. +%%----------------------------------------------------------------------- + +resolve_native_endianess(Flags) -> + case {Flags band 16#10, hipe_rtl_arch:endianess()} of + {16#10, big} -> + Flags band 5; + {16#10, little} -> + (Flags bor 2) band 7; + _ -> + Flags band 7 + end. + +%%----------------------------------------------------------------------- +%% Potentially useful for debugging. +%%----------------------------------------------------------------------- + +pp_beam(BeamCode, Options) -> + case proplists:get_value(pp_beam, Options) of + true -> + pp(BeamCode); + {file,FileName} -> + {ok,File} = file:open(FileName, [write]), + pp(File, BeamCode); + _ -> %% includes "false" case + ok + end. + +pp(Code) -> + pp(standard_io, Code). + +pp(Stream, []) -> + case Stream of %% I am not sure whether this is necessary + standard_io -> ok; + _ -> ok = file:close(Stream) + end; +pp(Stream, [FunCode|FunCodes]) -> + pp_mfa(Stream, FunCode), + put_nl(Stream), + pp(Stream, FunCodes). + +pp_mfa(Stream, FunCode) -> + lists:foreach(fun(Instr) -> print_instr(Stream, Instr) end, FunCode). + +print_instr(Stream, {label,Lbl}) -> + io:format(Stream, " label ~p:\n", [Lbl]); +print_instr(Stream, Op) -> + io:format(Stream, " ~p\n", [Op]). + +put_nl(Stream) -> + io:format(Stream, "\n", []). + +%%----------------------------------------------------------------------- +%% Handling of environments -- used to process local tail calls. +%%----------------------------------------------------------------------- + +%% Construct an environment +env__mk_env(M, F, A, Entry) -> + #environment{mfa={M,F,A}, entry=Entry}. + +%% Get current MFA +env__get_mfa(#environment{mfa=MFA}) -> MFA. + +%% Get entry point of the current function +env__get_entry(#environment{entry=EP}) -> EP. + +%%----------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl new file mode 100644 index 0000000000..a4614d7237 --- /dev/null +++ b/lib/hipe/icode/hipe_icode.erl @@ -0,0 +1,1820 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% HiPE Intermediate Code +%% ==================================================================== +%% Filename : hipe_icode.erl +%% Module : hipe_icode +%% Purpose : Provide primops for the Icode data structure. +%% History : 1997-? Erik Johansson (happi@it.uu.se): Created. +%% 2001-01-30 EJ (happi@it.uu.se): +%% Apply, primop, guardop removed +%% 2003-03-15 ES (happi@acm.org): +%% Started commenting in Edoc. +%% Moved pretty printer to separate file. +%% +%% $Id$ +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%@doc +%% This module implements "Linear Icode" and Icode instructions. +%% +%%

Icode is a simple (in that it has few instructions) imperative +%% language, used as the first Intermediate Code in the HiPE compiler. +%% Icode is closely related to Erlang, and Icode instructions operate +%% on Erlang terms.

+%% +%%

Icode

+%% +%%

Linear Icode for a function consists of: +%%

    +%%
  • the function's name (`{M,F,A}'),
    • +%%
  • a list of parameters,
    • +%%
  • a list of instructions,
    • +%%
  • data,
    • +%%
  • information about whether the function is a leaf function,
    • +%%
  • information about whether the function is a closure, and
    • +%%
  • the range for labels and variables in the code.
    • +%%
+%%

+%% +%%

Icode Instructions (and +%% their components)

+%% +%% Control flow: +%%
+%%
'if' +%% {Cond::cond(), +%% Args::[arg()], +%% TrueLabel::label_name(), +%% FalseLabel::label_name() +%% } :: +%% icode_instr()
+%%
+%% The if instruction compares the arguments (Args) with +%% condition (Cond) and jumps to either TrueLabel or +%% FalseLabel. (At the moment...) There are only binary +%% conditions so the number of arguments should be two. +%%

+%% An if instructions ends a basic block and should be followed +%% by a label (or be the last instruction of the code). +%%

+%% +%%
switch_val +%% {Term::var(), +%% FailLabel::label_name(), +%% Length::integer(), +%% Cases::[{symbol(),label_name()}] +%% }:: +%% icode_instr()
+%%
+%% The switch_val instruction compares the argument Term to the +%% symbols in the lists Cases, control is transfered to the label +%% that corresponds to the first symbol that matches. If no +%% symbol matches control is transfered to FailLabel. (NOTE: The +%% length argument is not currently in use.) +%%

+%% The switch_val instruction can be assumed to be implemented as +%% efficiently as possible given the symbols in the case +%% list. (Jump-table, bianry-serach, or nested ifs) +%%

+%% A switch_val instructions ends a basic block and should be +%% followed by a label (or be the last instruction of the code). +%%

+%% +%%
switch_tuple_arity +%% {Term::var(), +%% FailLabel::label_name(), +%% Length::integer(), +%% Cases::[{integer(),label_name()}] +%% }:: +%% icode_instr()
+%%
+%% The switch_tuple_arity instruction compares the size of the +%% tuple in the argument Term to the integers in the lists Cases, +%% control is transfered to the label that corresponds to the +%% first integer that matches. If no integer matches control is +%% transfered to FailLabel. (NOTE: The length argument is not +%% currently in use.) +%%

+%% The switch_tuple_arity instruction can be assumed to be +%% implemented as efficently as possible given the symbols in the +%% case list. (Jump-table, bianry-serach, or nested ifs) +%%

+%% A switch_tuple_arity instructions ends a basic block and +%% should be followed by a label (or be the last instruction of +%% the code). +%%

+%% +%%
`type {typ_expr, arg, true_label, false_label}}'
+%%
`goto {label}'
+%%
`label {name}'
+%%
+%% +%% Moves: +%%
+%%
`move {dst, src}'
+%%
`phi {dst, arglist}'
+%%
+%% +%% Function application: +%%
+%%
`call {[dst], fun, [arg], type, continuation, fail, +%% in_guard}'
+%%
+%% Where `type' is one of {`local', `remote', `primop'} +%% and `in_guard' is either `true' or `false'.
+%%
`enter {fun, [arg], type}'
+%%
+%% Where `type' is one of {`local', `remote', `primop'} +%% and `in_guard' is either `true' or `false'.
+%%
`return {[var]}'
+%%
+%% WARNING: Multiple return values are yet not +%% fully implemented and tested. +%%
+%%
+%% +%% Error handling: +%%
+%%
`begin_try {label, successor}'
+%%
`end_try'
+%%
`begin_handler {dstlist}'
+%%
`fail {Args, Class}'
+%%
Where `Class' is one of +%% {`exit', `throw', `error', `rethrow'}. For `error/2', `[args]' +%% is `[Reason,Trace]'. For `rethrow', `Args' is +%% `[Exception,Reason]' - this only occurs in autogenerated code. +%%
+%%
+%% +%% Comments: +%%
+%%
`comment{Text::string()}'
+%%
+%% +%%

Notes

+%% +%%

A constant can only show up on the RHS of a `move' instruction +%% and in `if' and `switch_*'

+%%

+%% Classification of primops should be like this: +%%

    +%%
  • `erlang:exit/1, erlang:throw/1, erlang:error/1, +%% erlang:error/2, erlang:fault/1', +%% and `erlang:fault/2' should use the +%% {@link fail(). fail-instruction} in Icode.
    • +%%
  • Calls or tail-recursive calls to BIFs, operators, or internal +%% functions should be implemented with `call' or `enter' +%% respectively, with the primop flag set.
    • +%%
  • All other Erlang functions should be implemented with `call' +%% or `enter' respectively, without the primop flag set.
    • +%%
+%%

+%% +%%

Primops

+%% +%% 
+%%  Constructors:
+%%    cons                       - [Car, Cdr]
+%%    mktuple                    - [Element1, Element2, ..., ElementN]
+%%    call_fun                   - [BoundArg1, ..., BoundArgN, Fun]
+%%    enter_fun                  - [BoundArg1, ..., BoundArgN, Fun]
+%%    #mkfun{}                   - [FreeVar1, FreeVar2, ..., FreeVarN]
+%%
+%%  Binaries:
+%%    bs_init
+%%    {bs_put_string, Bytes, Size}
+%%    bs_final
+%%
+%%  Selectors:
+%%    element                    - [Index, Tuple]
+%%    unsafe_hd                  - [List]
+%%    unsafe_tl                  - [List]
+%%    #unsafe_element{}          - [Tuple]
+%%    #unsafe_update_element{}   - [Tuple, Val]
+%%    #closure_element{}         - [Fun]
+%%
+%%  Arithmetic:       [Arg1, Arg2]
+%%    '+', '-', '*', '/', 'div', 'rem',
+%%    'band', 'bor', 'bxor', 'bnot', 'bsl', 'bsr'
+%%
+%%  Receive:         
+%%    check_get_msg - []
+%%    next_msg      - []
+%%    select_msg    - []
+%%    set_timeout   - [Timeout]
+%%    clear_timeout - []
+%%    suspend_msg   - []
+%%
+%%
+%% +%%

Guardops: (primops that can be used in guards and can fail)

+%% 
+%%  Selectors:
+%%    unsafe_hd         - [List]
+%%    unsafe_tl         - [List]
+%%    #element{}        - [Index, Tuple]
+%%    #unsafe_element{} - [Tuple]
+%%
+%%  Arithmetic:       [Arg1, Arg2]
+%%    '+', '-', '*', '/', 'div', 'rem',
+%%   'band', 'bor', 'bxor', 'bnot', 'bsl', 'bsr',
+%%    fix_add, fix_sub               %% Do these exist?
+%%
+%%  Concurrency:
+%%    {erlang,self,0}          - []
+%%
+%% +%% +%%

Relational Operations (Cond in if instruction)

+%% 
+%%    gt, lt, geq, leq,
+%%    eqeq, neq, exact_eqeq, exact_neq
+%%
+%% +%%

Type tests

+%% 
+%%    list
+%%    nil
+%%    cons
+%%    tuple
+%%    {tuple, N}
+%%    atom
+%%    {atom, Atom}
+%%    constant
+%%    number
+%%    integer
+%%    {integer, N}
+%%    fixnum
+%%    bignum
+%%    float
+%%    pid
+%%    port
+%%    {record, Atom, Size}
+%%    reference
+%%    binary
+%%    function
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%===================================================================== + +-module(hipe_icode). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). + +%% @type icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange,LabelRange) +%% Fun = mfa() +%% Params = [var()] +%% IsClosure = boolean() +%% IsLeaf = boolean() +%% Code = [icode_instr()] +%% Data = data() +%% VarRange = {integer(),integer()} +%% LabelRange = {integer(),integer()} +%% +%% @type icode_instr(I) +%% I = if() | switch_val() | switch_tuple_arity() | type() | goto() +%% | label() | move() | phi() | call() | enter() | return() +%% | begin_try() | end_try() | begin_handler() | fail() | comment() +%% +%% @type if(Cond, Args, TrueLabel, FalseLabel) +%% Cond = cond() +%% Args = [arg()] +%% TrueLabel = label_name() +%% FalseLabel = label_name() +%% +%% @type switch_val(Term, FailLabel, Length, Cases) +%% Term = var() +%% FailLabel = label_name() +%% Length = integer() +%% Cases = [{symbol(),label_name()}] +%% +%% @type switch_tuple_arity(Arg, FailLabel, Length, Cases) +%% Term = var() +%% FailLabel = label_name() +%% Length = integer() +%% Cases = [{symbol(),label_name()}] +%% +%% @type type(TypeTest, Arg, True_label, False_label) +%% TypeTest = type_test() +%% Args = [arg()] +%% TrueLabel = label_name() +%% FalseLabel = label_name() +%% +%% @type goto(Label) Label = label_name() +%% +%% @type label(Name) Name = label_name() +%% +%% @type move(Dst, Src) Dst = var() Src = arg() +%% +%% @type phi(Dst, Id, Arglist) +%% Dst = var() | fvar() +%% Id = var() | fvar() +%% Arglist = [{Pred, Src}] +%% Pred = label_name() +%% Src = var() | fvar() +%% +%% @type call(Dst, Fun, Arg, Type, Continuation, FailLabel, InGuard) +%% Dst = [var()] +%% Fun = mfa() | primop() | closure() +%% Arg = [var()] +%% Type = call_type() +%% Continuation = [] | label_name() +%% FailLabel = [] | label_name() +%% InGuard = boolean() +%% +%% @type enter(Fun, Arg, Type) +%% Fun = mfa() | primop() | closure() +%% Arg = [var()] +%% Type = call_type() +%% +%% @type return (Vars) Vars = [var()] +%% +%% @type begin_try(FailLabel, Successor) +%% FailLabel = label_name() +%% Successor = label_name() +%% +%% @type end_try() +%% +%% @type begin_handler(Dst) +%% Dst = [var()] +%% +%% @type fail(Class, Args, Label) +%% Class = exit_class() +%% Args = [var()] +%% Label = label_name() +%% +%% @type comment(Text) Text = string() + +%% @type call_type() = 'local' | 'remote' | 'primop' +%% @type exit_class() = 'exit' | 'throw' | 'error' | 'rethrow' +%% @type cond() = gt | lt | geq | leq | eqeq | neq | exact_eqeq | exact_neq +%% @type type_test() = +%% list +%% | nil +%% | cons +%% | tuple +%% | {tuple, integer()} +%% | atom +%% | {atom, atom()} +%% | constant +%% | number +%% | integer +%% | {integer, integer()} +%% | fixnum +%% | bignum +%% | float +%% | pid +%% | port +%% | {record, atom(), integer()} +%% | reference +%% | binary +%% | function +%% +%% @type mfa(Mod,Fun,Arity) = {atom(),atom(),arity()} + +%% @type arg() = var() | const() +%% @type farg() = fvar() | float() +%% @type var(Name) Name = integer() +%% @type fvar(Name) Name = integer() +%% @type label_name(Name) Name = integer() +%% @type symbol(S) = atom() | number() +%% @type const(C) C = immediate() +%% @type immediate(I) = I +%% I = term() +%% @end + + +%% ____________________________________________________________________ +%% +%% Exports +%% +-export([mk_icode/7, %% mk_icode(Fun, Params, IsClosure, IsLeaf, + %% Code, VarRange, LabelRange) + mk_icode/8, %% mk_icode(Fun, Params, IsClosure, IsLeaf, + %% Code, Data, VarRange, LabelRange) + icode_fun/1, + icode_params/1, + icode_params_update/2, + icode_is_closure/1, + icode_closure_arity/1, + icode_closure_arity_update/2, + icode_is_leaf/1, + icode_code/1, + icode_code_update/2, + icode_data/1, + %% icode_data_update/2, + icode_var_range/1, + icode_label_range/1, + icode_info/1, + icode_info_update/2]). + +-export([mk_if/4, %% mk_if(Op, Args, TrueLbl, FalseLbl) + %% mk_if/5, %% mk_if(Op, Args, TrueLbl, FalseLbl, Prob) + if_op/1, + if_op_update/2, + if_true_label/1, + if_false_label/1, + if_args/1, + if_pred/1, + %% is_if/1, + + mk_switch_val/4, + %% mk_switch_val/5, + switch_val_term/1, + switch_val_fail_label/1, + %% switch_val_length/1, + switch_val_cases/1, + switch_val_cases_update/2, + %% is_switch_val/1, + + mk_switch_tuple_arity/4, + %% mk_switch_tuple_arityl/5, + switch_tuple_arity_term/1, + switch_tuple_arity_fail_label/1, + switch_tuple_arity_fail_label_update/2, + %% switch_tuple_arity_length/1, + switch_tuple_arity_cases/1, + switch_tuple_arity_cases_update/2, + %% is_switch_tuple_arity/1, + + mk_type/4, %% mk_type(Args, Type, TrueLbl, FalseLbl) + mk_type/5, %% mk_type(Args, Type, TrueLbl, FalseLbl, P) + type_args/1, + %% type_args_update/2, + type_test/1, + type_true_label/1, + type_false_label/1, + type_pred/1, + is_type/1, + + mk_guardop/5, %% mk_guardop(Dst, Fun, Args, Continuation, Fail) + mk_primop/3, %% mk_primop(Dst, Fun, Args) + mk_primop/5, %% mk_primop(Dst, Fun, Args, Cont, Fail) + mk_call/5, %% mk_call(Dst, Mod, Fun, Args, Type) + %% mk_call/7, %% mk_call(Dst, Mod, Fun, Args, Type, + %% Continuation, Fail) + mk_call/8, %% mk_call(Dst, Mod, Fun, Args, Type, + %% Continuation, Fail, Guard) + call_dstlist/1, + call_dstlist_update/2, + %% call_dst_type/1, + call_args/1, + call_args_update/2, + call_fun/1, + call_fun_update/2, + call_type/1, + call_continuation/1, + call_fail_label/1, + call_set_fail_label/2, + call_set_continuation/2, + is_call/1, + call_in_guard/1, + + mk_goto/1, %% mk_goto(Lbl) + goto_label/1, + + mk_enter/4, %% mk_enter(Mod, Fun, Args, Type) + mk_enter_primop/2, %% mk_enter_primop(Op, Type) + enter_fun/1, + enter_fun_update/2, + enter_args/1, + enter_args_update/2, + enter_type/1, + is_enter/1, + + + mk_return/1, %% mk_return(Vars) + %% mk_fail/1, %% mk_fail(Args) class = exit + mk_fail/2, %% mk_fail(Args, Class) + %% mk_fail/3, %% mk_fail(Args, Class, Label) + mk_move/2, %% mk_move(Dst, Src) + %% mk_moves/2, %% mk_moves(DstList, SrcList) + mk_begin_try/2, %% mk_begin_try(Label, Successor) + mk_begin_handler/1, %% mk_begin_handler(ReasonDst) + mk_end_try/0, %% mk_end_try() + %% mk_elements/2, %% mk_elements(Tuple, Vars) + mk_label/1, %% mk_label(Name) + mk_new_label/0, %% mk_new_label() + mk_comment/1, %% mk_comment(Text) + mk_const/1, %% mk_const(Const) + mk_var/1, %% mk_var(Id) + annotate_variable/2, %% annotate_var_or_reg(VarOrReg, Type) + unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg) + mk_reg/1, %% mk_reg(Id) + mk_fvar/1, %% mk_fvar(Id) + mk_new_var/0, %% mk_new_var() + mk_new_fvar/0, %% mk_new_fvar() + mk_new_reg/0, %% mk_new_reg() + mk_phi/1, %% mk_phi(Id) + mk_phi/2 %% mk_phi(Id, ArgList) + ]). + +%% +%% Identifiers +%% + +-export([%% is_fail/1, + is_return/1, + is_move/1, + %% is_begin_try/1, + %% is_begin_handler/1, + %% is_end_try/1, + is_goto/1, + is_label/1, + is_comment/1, + is_const/1, + is_var/1, + is_fvar/1, + is_reg/1, + is_variable/1, + is_annotated_variable/1, + %% is_uncond/1, + is_phi/1]). + +%% +%% Selectors +%% + +-export([phi_dst/1, + phi_id/1, + %% phi_args/1, + phi_arg/2, + phi_arglist/1, + phi_enter_pred/3, + phi_remove_pred/2, + phi_redirect_pred/3, + move_dst/1, + move_src/1, + move_src_update/2, + begin_try_label/1, + begin_try_successor/1, + begin_handler_dstlist/1, + label_name/1, + comment_text/1, + return_vars/1, + fail_args/1, + fail_class/1, + fail_label/1, + fail_set_label/2, + var_name/1, + variable_annotation/1, + fvar_name/1, + reg_name/1, + reg_is_gcsafe/1, + const_value/1 + ]). + +%% +%% Misc +%% + +-export([args/1, + uses/1, + defines/1, + is_safe/1, + strip_comments/1, + subst/2, + subst_uses/2, + subst_defines/2, + redirect_jmp/3, + successors/1, + fails_to/1, + is_branch/1 + ]). + +-export([highest_var/1, highest_label/1]). + +%%--------------------------------------------------------------------- +%% +%% Icode +%% +%%--------------------------------------------------------------------- + +-spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], + {non_neg_integer(),non_neg_integer()}, + {icode_lbl(),icode_lbl()}) -> #icode{}. +mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> + #icode{'fun'=Fun, params=Params, code=Code, + is_closure=IsClosure, + is_leaf=IsLeaf, + data=hipe_consttab:new(), + var_range=VarRange, + label_range=LabelRange}. + +-spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], + hipe_consttab(), {non_neg_integer(),non_neg_integer()}, + {icode_lbl(),icode_lbl()}) -> #icode{}. +mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> + #icode{'fun'=Fun, params=Params, code=Code, + data=Data, is_closure=IsClosure, is_leaf=IsLeaf, + var_range=VarRange, label_range=LabelRange}. + +-spec icode_fun(#icode{}) -> mfa(). +icode_fun(#icode{'fun' = MFA}) -> MFA. + +-spec icode_params(#icode{}) -> [icode_var()]. +icode_params(#icode{params = Params}) -> Params. + +-spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}. +icode_params_update(Icode, Params) -> + Icode#icode{params = Params}. + +-spec icode_is_closure(#icode{}) -> boolean(). +icode_is_closure(#icode{is_closure = Closure}) -> Closure. + +-spec icode_is_leaf(#icode{}) -> boolean(). +icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf. + +-spec icode_code(#icode{}) -> icode_instrs(). +icode_code(#icode{code = Code}) -> Code. + +-spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}. +icode_code_update(Icode, NewCode) -> + Vmax = highest_var(NewCode), + Lmax = highest_label(NewCode), + Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}. + +-spec icode_data(#icode{}) -> hipe_consttab(). +icode_data(#icode{data=Data}) -> Data. + +%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}. +%% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}. + +-spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +icode_var_range(#icode{var_range = VarRange}) -> VarRange. + +-spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +icode_label_range(#icode{label_range = LabelRange}) -> LabelRange. + +-spec icode_info(#icode{}) -> icode_info(). +icode_info(#icode{info = Info}) -> Info. + +-spec icode_info_update(#icode{}, icode_info()) -> #icode{}. +icode_info_update(Icode, Info) -> Icode#icode{info = Info}. + +-spec icode_closure_arity(#icode{}) -> arity(). +icode_closure_arity(#icode{closure_arity = Arity}) -> Arity. + +-spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}. +icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}. + + +%%---------------------------------------------------------------------------- +%% Instructions +%%---------------------------------------------------------------------------- + +%%---- +%% if +%%---- + +-spec mk_if(icode_if_op(), [icode_term_arg()], + icode_lbl(), icode_lbl()) -> #icode_if{}. +mk_if(Op, Args, TrueLbl, FalseLbl) -> + #icode_if{op=Op, args=Args, true_label=TrueLbl, false_label=FalseLbl, p=0.5}. +%% mk_if(Op, Args, TrueLbl, FalseLbl, P) -> +%% #icode_if{op=Op, args=Args, true_label=TrueLbl, false_label=FalseLbl, p=P}. + +-spec if_op(#icode_if{}) -> icode_if_op(). +if_op(#icode_if{op=Op}) -> Op. + +-spec if_op_update(#icode_if{}, icode_if_op()) -> #icode_if{}. +if_op_update(IF, NewOp) -> IF#icode_if{op=NewOp}. + +-spec if_args(#icode_if{}) -> [icode_term_arg()]. +if_args(#icode_if{args=Args}) -> Args. + +-spec if_true_label(#icode_if{}) -> icode_lbl(). +if_true_label(#icode_if{true_label=TrueLbl}) -> TrueLbl. + +-spec if_true_label_update(#icode_if{}, icode_lbl()) -> #icode_if{}. +if_true_label_update(IF, TrueLbl) -> IF#icode_if{true_label=TrueLbl}. + +-spec if_false_label(#icode_if{}) -> icode_lbl(). +if_false_label(#icode_if{false_label=FalseLbl}) -> FalseLbl. + +-spec if_false_label_update(#icode_if{}, icode_lbl()) -> #icode_if{}. +if_false_label_update(IF, FalseLbl) -> IF#icode_if{false_label=FalseLbl}. + +-spec if_pred(#icode_if{}) -> float(). +if_pred(#icode_if{p=P}) -> P. + +%%------------ +%% switch_val +%%------------ + +-spec mk_switch_val(icode_var(), icode_lbl(), + non_neg_integer(), [icode_switch_case()]) -> + #icode_switch_val{}. +mk_switch_val(Term = #icode_variable{kind='var'}, FailLbl, Length, Cases) -> + #icode_switch_val{term=Term, fail_label=FailLbl, length=Length, cases=Cases}. + +-spec switch_val_term(#icode_switch_val{}) -> icode_var(). +switch_val_term(#icode_switch_val{term=Term}) -> Term. + +-spec switch_val_fail_label(#icode_switch_val{}) -> icode_lbl(). +switch_val_fail_label(#icode_switch_val{fail_label=FailLbl}) -> FailLbl. + +-spec switch_val_fail_label_update(#icode_switch_val{}, icode_lbl()) -> + #icode_switch_val{}. +switch_val_fail_label_update(SV, FailLbl) -> + SV#icode_switch_val{fail_label=FailLbl}. + +%% switch_val_length(#icode_switch_val{length=Length}) -> Length. + +-spec switch_val_cases(#icode_switch_val{}) -> [icode_switch_case()]. +switch_val_cases(#icode_switch_val{cases=Cases}) -> Cases. + +-spec switch_val_cases_update(#icode_switch_val{}, [icode_switch_case()]) -> + #icode_switch_val{}. +switch_val_cases_update(SV, NewCases) -> + SV#icode_switch_val{cases = NewCases}. + +%%-------------------- +%% switch_tuple_arity +%%-------------------- + +-spec mk_switch_tuple_arity(icode_var(), icode_lbl(), + non_neg_integer(), [icode_switch_case()]) -> + #icode_switch_tuple_arity{}. +mk_switch_tuple_arity(Term = #icode_variable{kind='var'}, FailLbl, Length, Cases) -> + #icode_switch_tuple_arity{term=Term, fail_label=FailLbl, + length=Length, cases=Cases}. + +-spec switch_tuple_arity_term(#icode_switch_tuple_arity{}) -> icode_var(). +switch_tuple_arity_term(#icode_switch_tuple_arity{term=Term}) -> Term. + +-spec switch_tuple_arity_fail_label(#icode_switch_tuple_arity{}) -> icode_lbl(). +switch_tuple_arity_fail_label(#icode_switch_tuple_arity{fail_label=FailLbl}) -> + FailLbl. + +-spec switch_tuple_arity_fail_label_update(#icode_switch_tuple_arity{}, icode_lbl()) -> + #icode_switch_tuple_arity{}. +switch_tuple_arity_fail_label_update(S, FailLbl) -> + S#icode_switch_tuple_arity{fail_label=FailLbl}. + +%% switch_tuple_arity_length(#icode_switch_tuple_arity{length=Length}) -> Length. + +-spec switch_tuple_arity_cases(#icode_switch_tuple_arity{}) -> [icode_switch_case()]. +switch_tuple_arity_cases(#icode_switch_tuple_arity{cases=Cases}) -> Cases. + +-spec switch_tuple_arity_cases_update(#icode_switch_tuple_arity{}, + [icode_switch_case()]) -> + #icode_switch_tuple_arity{}. +switch_tuple_arity_cases_update(Cond, NewCases) -> + Cond#icode_switch_tuple_arity{cases = NewCases}. + +%%------ +%% type +%%------ + +-spec mk_type([icode_term_arg()], icode_type_test(), icode_lbl(), icode_lbl()) -> + #icode_type{}. +mk_type(Args, Test, TrueLbl, FalseLbl) -> + mk_type(Args, Test, TrueLbl, FalseLbl, 0.5). + +-spec mk_type([icode_term_arg()], icode_type_test(), + icode_lbl(), icode_lbl(), float()) -> #icode_type{}. +mk_type(Args, Test, TrueLbl, FalseLbl, P) -> + #icode_type{test=Test, args=Args, + true_label=TrueLbl, false_label=FalseLbl, p=P}. + +-spec type_test(#icode_type{}) -> icode_type_test(). +type_test(#icode_type{test=Test}) -> Test. + +-spec type_args(#icode_type{}) -> [icode_term_arg()]. +type_args(#icode_type{args=Args}) -> Args. + +%% type_args_update(T, Args) -> T#icode_type{args=Args}. + +-spec type_true_label(#icode_type{}) -> icode_lbl(). +type_true_label(#icode_type{true_label=TrueLbl}) -> TrueLbl. + +-spec type_false_label(#icode_type{}) -> icode_lbl(). +type_false_label(#icode_type{false_label=FalseLbl}) -> FalseLbl. + +-spec type_pred(#icode_type{}) -> float(). +type_pred(#icode_type{p=P}) -> P. + +-spec is_type(icode_instr()) -> boolean(). +is_type(#icode_type{}) -> true; +is_type(_) -> false. + +%%------ +%% goto +%%------ + +-spec mk_goto(icode_lbl()) -> #icode_goto{}. +mk_goto(Lbl) -> #icode_goto{label=Lbl}. + +-spec goto_label(#icode_goto{}) -> icode_lbl(). +goto_label(#icode_goto{label=Lbl}) -> Lbl. + +-spec is_goto(icode_instr()) -> boolean(). +is_goto(#icode_goto{}) -> true; +is_goto(_) -> false. + +%%-------- +%% return +%%-------- + +-spec mk_return([icode_var()]) -> #icode_return{}. +mk_return(Vars) -> #icode_return{vars=Vars}. + +-spec return_vars(#icode_return{}) -> [icode_var()]. +return_vars(#icode_return{vars=Vars}) -> Vars. + +-spec is_return(icode_instr()) -> boolean(). +is_return(#icode_return{}) -> true; +is_return(_) -> false. + +%%------ +%% fail +%%------ + +%% mk_fail(Args) when is_list(Args) -> mk_fail(Args, error). + +-spec mk_fail([icode_term_arg()], icode_exit_class()) -> #icode_fail{}. +mk_fail(Args, Class) when is_list(Args) -> + case Class of + error -> ok; + exit -> ok; + rethrow -> ok; + throw -> ok + end, + #icode_fail{class=Class, args=Args}. + +%% mk_fail(Args, Class, Label) when is_list(Args) -> +%% #icode_fail{class=Class, args=Args, fail_label=Label}. + +-spec fail_class(#icode_fail{}) -> icode_exit_class(). +fail_class(#icode_fail{class=Class}) -> Class. + +-spec fail_args(#icode_fail{}) -> [icode_term_arg()]. +fail_args(#icode_fail{args=Args}) -> Args. + +-spec fail_label(#icode_fail{}) -> [] | icode_lbl(). +fail_label(#icode_fail{fail_label=Label}) -> Label. + +-spec fail_set_label(#icode_fail{}, [] | icode_lbl()) -> #icode_fail{}. +fail_set_label(I=#icode_fail{}, Label) -> + I#icode_fail{fail_label = Label}. + +%%------ +%% move +%%------ + +-spec mk_move(#icode_variable{}, #icode_variable{} | #icode_const{}) -> + #icode_move{}. +mk_move(Dst, Src) -> + case Src of + #icode_variable{} -> ok; + #icode_const{} -> ok + end, + #icode_move{dst=Dst, src=Src}. + +-spec move_dst(#icode_move{}) -> #icode_variable{}. +move_dst(#icode_move{dst=Dst}) -> Dst. + +-spec move_src(#icode_move{}) -> #icode_variable{} | #icode_const{}. +move_src(#icode_move{src=Src}) -> Src. + +-spec move_src_update(#icode_move{}, #icode_variable{} | #icode_const{}) -> + #icode_move{}. +move_src_update(M, NewSrc) -> M#icode_move{src=NewSrc}. + +-spec is_move(icode_instr()) -> boolean(). +is_move(#icode_move{}) -> true; +is_move(_) -> false. + +%%----- +%% phi +%%----- + +%% The id field is not entirely redundant. It is used in mappings +%% in the SSA pass since the dst field can change. +-spec mk_phi(#icode_variable{}) -> #icode_phi{}. +mk_phi(Var) -> #icode_phi{dst=Var, id=Var, arglist=[]}. + +-spec mk_phi(#icode_variable{}, [{icode_lbl(), #icode_variable{}}]) -> + #icode_phi{}. +mk_phi(Var, ArgList) -> #icode_phi{dst=Var, id=Var, arglist=ArgList}. + +-spec phi_dst(#icode_phi{}) -> #icode_variable{}. +phi_dst(#icode_phi{dst=Dst}) -> Dst. + +-spec phi_id(#icode_phi{}) -> #icode_variable{}. +phi_id(#icode_phi{id=Id}) -> Id. + +-spec phi_arglist(#icode_phi{}) -> [{icode_lbl(), #icode_variable{}}]. +phi_arglist(#icode_phi{arglist=ArgList}) -> ArgList. + +-spec phi_args(#icode_phi{}) -> [#icode_variable{}]. +phi_args(P) -> [Var || {_, Var} <- phi_arglist(P)]. + +-spec phi_arg(#icode_phi{}, icode_lbl()) -> #icode_variable{}. +phi_arg(P, Pred) -> + case lists:keyfind(Pred, 1, phi_arglist(P)) of + {_, Var} -> Var; + false -> exit({'No such predecessor to phi', {Pred, P}}) + end. + +-spec is_phi(icode_instr()) -> boolean(). +is_phi(#icode_phi{}) -> true; +is_phi(_) -> false. + +-spec phi_enter_pred(#icode_phi{}, icode_lbl(), #icode_variable{}) -> + #icode_phi{}. +phi_enter_pred(Phi, Pred, Var) -> + NewArg = {Pred, Var}, + Phi#icode_phi{arglist=[NewArg|lists:keydelete(Pred, 1, phi_arglist(Phi))]}. + +-spec phi_remove_pred(#icode_phi{}, icode_lbl()) -> #icode_move{} | #icode_phi{}. +phi_remove_pred(Phi, Pred) -> + NewArgList = lists:keydelete(Pred, 1, phi_arglist(Phi)), + case NewArgList of + [Arg] -> %% the Phi should be turned into an appropriate move instruction + {_Label, Var = #icode_variable{}} = Arg, + mk_move(phi_dst(Phi), Var); + [_|_] -> + Phi#icode_phi{arglist=NewArgList} + end. + +phi_argvar_subst(P, Subst) -> + NewArgList = [{Pred, subst1(Subst, Var)} || {Pred,Var} <- phi_arglist(P)], + P#icode_phi{arglist=NewArgList}. + +-spec phi_redirect_pred(#icode_phi{}, icode_lbl(), icode_lbl()) -> #icode_phi{}. +phi_redirect_pred(P, OldPred, NewPred) -> + Subst = [{OldPred, NewPred}], + NewArgList = [{subst1(Subst, Pred), Var} || {Pred,Var} <- phi_arglist(P)], + P#icode_phi{arglist=NewArgList}. + +%% +%% primop and guardop +%% +%% Whether a function is a "primop" - i.e., an internal thing - or not, +%% is really only shown by its name. An {M,F,A} always represents a +%% function in some Erlang module (although it might be a BIF, and +%% could possibly be inline expanded). It is convenient to let the +%% constructor functions check the name and set the type automatically, +%% especially for guardops - some guardops are primitives and some are +%% MFA:s, and this way we won't have to rewrite all calls to mk_guardop +%% to flag whether they are primops or not. + +-spec mk_primop([#icode_variable{}], icode_funcall(), + [icode_argument()]) -> #icode_call{}. +mk_primop(DstList, Fun, ArgList) -> + mk_primop(DstList, Fun, ArgList, [], []). + +-spec mk_primop([#icode_variable{}], icode_funcall(), + [icode_argument()], [] | icode_lbl(), [] | icode_lbl()) -> + #icode_call{}. +mk_primop(DstList, Fun, ArgList, Continuation, Fail) -> + Type = op_type(Fun), + make_call(DstList, Fun, ArgList, Type, Continuation, Fail, false). + +%% Note that a 'guardop' is just a call that occurred in a guard. In +%% this case, we should always have continuation labels True and False. + +-spec mk_guardop([#icode_variable{}], icode_funcall(), + [icode_argument()], icode_lbl(), icode_lbl()) -> #icode_call{}. +mk_guardop(DstList, Fun, ArgList, True, False) -> + Type = op_type(Fun), + make_call(DstList, Fun, ArgList, Type, True, False, true). + +op_type(Fun) -> + case is_mfa(Fun) of + true -> remote; + false -> primop + end. + +is_mfa({M,F,A}) when is_atom(M), is_atom(F), + is_integer(A), 0 =< A, A =< 255 -> true; +is_mfa(_) -> false. + +%%------ +%% call +%%------ + +-spec mk_call([#icode_variable{}], atom(), atom(), + [icode_argument()], 'local' | 'remote') -> #icode_call{}. +mk_call(DstList, M, F, ArgList, Type) -> + mk_call(DstList, M, F, ArgList, Type, [], [], false). + +%% mk_call(DstList, M, F, ArgList, Type, Continuation, Fail) -> +%% mk_call(DstList, M, F, ArgList, Type, Continuation, Fail, false). + +-spec mk_call([#icode_variable{}], atom(), atom(), [icode_argument()], + 'local' | 'remote', [] | icode_lbl(), [] | icode_lbl(), boolean()) -> + #icode_call{}. +mk_call(DstList, M, F, ArgList, Type, Continuation, Fail, InGuard) + when is_atom(M), is_atom(F) -> + case Type of + local -> ok; + remote -> ok + end, + Fun = {M,F,length(ArgList)}, + make_call(DstList, Fun, ArgList, Type, Continuation, Fail, InGuard). + +%% The common constructor for all calls (for internal use only) +%% +%% Note: If the "guard" flag is `true', it means that if the call fails, +%% we can simply jump to the Fail label (if it exists) without +%% generating any additional exception information - it isn't needed. +-spec make_call([#icode_variable{}], icode_funcall(), [icode_argument()], + icode_call_type(), [] | icode_lbl(), [] | icode_lbl(), boolean()) -> + #icode_call{}. +make_call(DstList, Fun, ArgList, Type, Continuation, Fail, InGuard) -> + #icode_call{dstlist=DstList, 'fun'=Fun, args=ArgList, type=Type, + continuation=Continuation, fail_label=Fail, in_guard=InGuard}. + +-spec call_dstlist(#icode_call{}) -> [#icode_variable{}]. +call_dstlist(#icode_call{dstlist=DstList}) -> DstList. + +-spec call_dstlist_update(#icode_call{}, [#icode_variable{}]) -> #icode_call{}. +call_dstlist_update(C, Dest) -> C#icode_call{dstlist=Dest}. + +-spec call_type(#icode_call{}) -> icode_call_type(). +call_type(#icode_call{type=Type}) -> Type. + +%% -spec call_dst_type(#icode_call{}) -> erl_type(). +%% call_dst_type(#icode_call{dst_type=DstType}) -> DstType. + +-spec call_args(#icode_call{}) -> [icode_argument()]. +call_args(#icode_call{args=Args}) -> Args. + +-spec call_args_update(#icode_call{}, [icode_argument()]) -> #icode_call{}. +call_args_update(C, Args) -> C#icode_call{args=Args}. + +-spec call_fun(#icode_call{}) -> icode_funcall(). +call_fun(#icode_call{'fun'=Fun}) -> Fun. + +%% Note that updating the name field requires recomputing the call type, +%% in case it changes from a remote/local call to a primop call. +-spec call_fun_update(#icode_call{}, icode_funcall()) -> #icode_call{}. +call_fun_update(C, Fun) -> + Type = case is_mfa(Fun) of + true -> call_type(C); + false -> primop + end, + C#icode_call{'fun'=Fun, type=Type}. + +-spec call_continuation(#icode_call{}) -> [] | icode_lbl(). +call_continuation(#icode_call{continuation=Continuation}) -> Continuation. + +-spec call_fail_label(#icode_call{}) -> [] | icode_lbl(). +call_fail_label(#icode_call{fail_label=Fail}) -> Fail. + +-spec call_set_continuation(#icode_call{}, [] | icode_lbl()) -> #icode_call{}. +call_set_continuation(I, Continuation) -> + I#icode_call{continuation = Continuation}. + +-spec call_set_fail_label(#icode_call{}, [] | icode_lbl()) -> #icode_call{}. +call_set_fail_label(I=#icode_call{}, Fail) -> + case Fail of + [] -> + I#icode_call{fail_label=Fail, in_guard=false}; + _ -> + I#icode_call{fail_label=Fail} + end. + +-spec is_call(icode_instr()) -> boolean(). +is_call(#icode_call{}) -> true; +is_call(_) -> false. + +-spec call_in_guard(#icode_call{}) -> boolean(). +call_in_guard(#icode_call{in_guard=InGuard}) -> InGuard. + +%%------- +%% enter +%%------- + +-spec mk_enter(atom(), atom(), [icode_term_arg()], 'local' | 'remote') -> + #icode_enter{}. +mk_enter(M, F, Args, Type) when is_atom(M), is_atom(F) -> + case Type of + local -> ok; + remote -> ok + end, + #icode_enter{'fun'={M,F,length(Args)}, args=Args, type=Type}. + +-spec enter_fun(#icode_enter{}) -> icode_funcall(). +enter_fun(#icode_enter{'fun'=Fun}) -> Fun. + +-spec enter_fun_update(#icode_enter{}, icode_funcall()) -> + #icode_enter{}. +enter_fun_update(E, Fun) -> + Type = case is_mfa(Fun) of + true -> enter_type(E); + false -> primop + end, + E#icode_enter{'fun'=Fun, type=Type}. + +-spec enter_args(#icode_enter{}) -> [icode_term_arg()]. +enter_args(#icode_enter{args=Args}) -> Args. + +-spec enter_args_update(#icode_enter{}, [icode_term_arg()]) -> #icode_enter{}. +enter_args_update(E, Args) -> E#icode_enter{args=Args}. + +-spec enter_type(#icode_enter{}) -> icode_call_type(). +enter_type(#icode_enter{type=Type}) -> Type. + +-spec is_enter(icode_instr()) -> boolean(). +is_enter(#icode_enter{}) -> true; +is_enter(_) -> false. + +-spec mk_enter_primop(icode_primop(), [icode_term_arg()]) -> + #icode_enter{type::'primop'}. +mk_enter_primop(Op, Args) -> + #icode_enter{'fun'=Op, args=Args, type=primop}. + +%%----------- +%% begin_try +%%----------- + +%% The reason that begin_try is a branch instruction is just so that it +%% keeps the fail-to block linked into the CFG, until the exception +%% handling instructions are eliminated. + +-spec mk_begin_try(icode_lbl(), icode_lbl()) -> #icode_begin_try{}. +mk_begin_try(Label, Successor) -> + #icode_begin_try{label=Label, successor=Successor}. + +-spec begin_try_label(#icode_begin_try{}) -> icode_lbl(). +begin_try_label(#icode_begin_try{label=Label}) -> Label. + +-spec begin_try_successor(#icode_begin_try{}) -> icode_lbl(). +begin_try_successor(#icode_begin_try{successor=Successor}) -> Successor. + +%%--------- +%% end_try +%%--------- + +-spec mk_end_try() -> #icode_end_try{}. +mk_end_try() -> #icode_end_try{}. + +%%--------------- +%% begin_handler +%%--------------- + +-spec mk_begin_handler([icode_var()]) -> #icode_begin_handler{}. +mk_begin_handler(Dstlist) -> + #icode_begin_handler{dstlist=Dstlist}. + +-spec begin_handler_dstlist(#icode_begin_handler{}) -> [icode_var()]. +begin_handler_dstlist(#icode_begin_handler{dstlist=Dstlist}) -> Dstlist. + +%% -spec is_begin_handler(icode_instr()) -> boolean(). +%% is_begin_handler(#icode_begin_handler{}) -> true; +%% is_begin_handler(_) -> false. + +%%------- +%% label +%%------- + +-spec mk_label(icode_lbl()) -> #icode_label{}. +mk_label(Name) when is_integer(Name), Name >= 0 -> #icode_label{name=Name}. + +-spec label_name(#icode_label{}) -> icode_lbl(). +label_name(#icode_label{name=Name}) -> Name. + +-spec is_label(icode_instr()) -> boolean(). +is_label(#icode_label{}) -> true; +is_label(_) -> false. + +%%--------- +%% comment +%%--------- + +-spec mk_comment(icode_comment_text()) -> #icode_comment{}. +%% @doc If `Txt' is a list of characters (possibly deep), it will be +%% printed as a string; otherwise, `Txt' will be printed as a term. +mk_comment(Txt) -> #icode_comment{text=Txt}. + +-spec comment_text(#icode_comment{}) -> icode_comment_text(). +comment_text(#icode_comment{text=Txt}) -> Txt. + +-spec is_comment(icode_instr()) -> boolean(). +is_comment(#icode_comment{}) -> true; +is_comment(_) -> false. + + +%%--------------------------------------------------------------------- +%% Arguments (variables and constants) +%%--------------------------------------------------------------------- + +%%------- +%% const +%%------- + +-spec mk_const(simple_const() | structured_const() | binary()) -> #icode_const{}. +mk_const(C) -> #icode_const{value=#flat{value=C}}. + +-spec const_value(#icode_const{}) -> simple_const() | structured_const() | binary(). +const_value(#icode_const{value=#flat{value=X}}) -> X. + +-spec is_const(icode_argument()) -> boolean(). +is_const(#icode_const{}) -> true; +is_const(_) -> false. + +%%----- +%% var +%%----- + +-spec mk_var(non_neg_integer()) -> #icode_variable{kind::'var'}. +mk_var(V) -> #icode_variable{name=V, kind=var}. + +-spec var_name(#icode_variable{kind::'var'}) -> non_neg_integer(). +var_name(#icode_variable{name=Name, kind=var}) -> Name. + +-spec is_var(icode_argument()) -> boolean(). +is_var(#icode_variable{kind=var}) -> true; +is_var(_) -> false. + +-spec mk_reg(non_neg_integer()) -> #icode_variable{kind::'reg'}. +mk_reg(V) -> #icode_variable{name=V, kind=reg}. + +-spec reg_name(#icode_variable{kind::'reg'}) -> non_neg_integer(). +reg_name(#icode_variable{name=Name, kind=reg}) -> Name. + +-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'. +reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now + +-spec is_reg(icode_argument()) -> boolean(). +is_reg(#icode_variable{kind=reg}) -> true; +is_reg(_) -> false. + +-spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}. +mk_fvar(V) -> #icode_variable{name=V, kind=fvar}. + +-spec fvar_name(#icode_variable{kind::'fvar'}) -> non_neg_integer(). +fvar_name(#icode_variable{name=Name, kind=fvar}) -> Name. + +-spec is_fvar(icode_argument()) -> boolean(). +is_fvar(#icode_variable{kind=fvar}) -> true; +is_fvar(_) -> false. + +-spec is_variable(icode_argument()) -> boolean(). +is_variable(#icode_variable{}) -> true; +is_variable(_) -> false. + +-spec annotate_variable(#icode_variable{}, variable_annotation()) -> + #icode_variable{}. +annotate_variable(X, Anno) -> + X#icode_variable{annotation = Anno}. + +-spec is_annotated_variable(icode_argument()) -> boolean(). +is_annotated_variable(#icode_variable{annotation=[]}) -> + false; +is_annotated_variable(#icode_variable{}) -> + true; +is_annotated_variable(_) -> + false. + +-spec unannotate_variable(#icode_variable{}) -> #icode_variable{}. +unannotate_variable(X) -> + X#icode_variable{annotation=[]}. + +-spec variable_annotation(#icode_variable{}) -> variable_annotation(). +variable_annotation(#icode_variable{annotation=Anno}) -> + Anno. + +%% +%% Floating point Icode instructions. +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Liveness info +%% + +-spec uses(icode_instr()) -> [#icode_variable{}]. +uses(Instr) -> + remove_constants(args(Instr)). + +-spec args(icode_instr()) -> [icode_argument()]. +args(I) -> + case I of + #icode_if{} -> if_args(I); + #icode_switch_val{} -> [switch_val_term(I)]; + #icode_switch_tuple_arity{} -> [switch_tuple_arity_term(I)]; + #icode_type{} -> type_args(I); + #icode_move{} -> [move_src(I)]; + #icode_fail{} -> fail_args(I); + #icode_call{} -> call_args(I); + #icode_enter{} -> enter_args(I); + #icode_return{} -> return_vars(I); + #icode_phi{} -> phi_args(I); + #icode_goto{} -> []; + #icode_begin_try{} -> []; + #icode_begin_handler{} -> []; + #icode_end_try{} -> []; + #icode_comment{} -> []; + #icode_label{} -> [] + end. + +-spec defines(icode_instr()) -> [#icode_variable{}]. +defines(I) -> + case I of + #icode_move{} -> remove_constants([move_dst(I)]); + #icode_call{} -> remove_constants(call_dstlist(I)); + #icode_begin_handler{} -> remove_constants(begin_handler_dstlist(I)); + #icode_phi{} -> remove_constants([phi_dst(I)]); + #icode_if{} -> []; + #icode_switch_val{} -> []; + #icode_switch_tuple_arity{} -> []; + #icode_type{} -> []; + #icode_goto{} -> []; + #icode_fail{} -> []; + #icode_enter{} -> []; + #icode_return{} -> []; + #icode_begin_try{} -> []; + #icode_end_try{} -> []; + #icode_comment{} -> []; + #icode_label{} -> [] + end. + +-spec remove_constants([icode_argument()]) -> [#icode_variable{}]. +remove_constants(L) -> + [V || V <- L, (not is_const(V))]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Utilities +%% + +%% +%% Substitution: replace occurrences of X by Y if {X,Y} is in the +%% Subst_list. + +-spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()). + +subst(Subst, I) -> + subst_defines(Subst, subst_uses(Subst, I)). + +-spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()). + +subst_uses(Subst, I) -> + case I of + #icode_if{} -> I#icode_if{args = subst_list(Subst, if_args(I))}; + #icode_switch_val{} -> + I#icode_switch_val{term = subst1(Subst, switch_val_term(I))}; + #icode_switch_tuple_arity{} -> + I#icode_switch_tuple_arity{term = subst1(Subst, switch_tuple_arity_term(I))}; + #icode_type{} -> I#icode_type{args = subst_list(Subst, type_args(I))}; + #icode_move{} -> I#icode_move{src = subst1(Subst, move_src(I))}; + #icode_fail{} -> I#icode_fail{args = subst_list(Subst, fail_args(I))}; + #icode_call{} -> I#icode_call{args = subst_list(Subst, call_args(I))}; + #icode_enter{} -> I#icode_enter{args = subst_list(Subst, enter_args(I))}; + #icode_return{} -> I#icode_return{vars = subst_list(Subst, return_vars(I))}; + #icode_phi{} -> phi_argvar_subst(I, Subst); + #icode_goto{} -> I; + #icode_begin_try{} -> I; + #icode_begin_handler{} -> I; + #icode_end_try{} -> I; + #icode_comment{} -> I; + #icode_label{} -> I + end. + +-spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()). + +subst_defines(Subst, I) -> + case I of + #icode_move{} -> I#icode_move{dst = subst1(Subst, move_dst(I))}; + #icode_call{} -> + I#icode_call{dstlist = subst_list(Subst, call_dstlist(I))}; + #icode_begin_handler{} -> + I#icode_begin_handler{dstlist = subst_list(Subst, + begin_handler_dstlist(I))}; + #icode_phi{} -> I#icode_phi{dst = subst1(Subst, phi_dst(I))}; + #icode_if{} -> I; + #icode_switch_val{} -> I; + #icode_switch_tuple_arity{} -> I; + #icode_type{} -> I; + #icode_goto{} -> I; + #icode_fail{} -> I; + #icode_enter{} -> I; + #icode_return{} -> I; + #icode_begin_try{} -> I; + #icode_end_try{} -> I; + #icode_comment{} -> I; + #icode_label{} -> I + end. + +subst_list(S, Is) -> + [subst1(S, I) || I <- Is]. + +subst1([], I) -> I; +subst1([{I,Y}|_], I) -> Y; +subst1([_|Pairs], I) -> subst1(Pairs, I). + +%% +%% @doc Returns the successors of an Icode instruction. +%% In CFG form only branch instructions have successors, +%% but in linear form other instructions like e.g. moves and +%% others might be the last instruction of some basic block. +%% + +-spec successors(icode_instr()) -> [icode_lbl()]. + +successors(I) -> + case I of + #icode_if{} -> + [if_true_label(I), if_false_label(I)]; + #icode_goto{} -> + [goto_label(I)]; + #icode_switch_val{} -> + CaseLabels = [L || {_,L} <- switch_val_cases(I)], + [switch_val_fail_label(I) | CaseLabels]; + #icode_switch_tuple_arity{} -> + CaseLabels = [L || {_,L} <- switch_tuple_arity_cases(I)], + [switch_tuple_arity_fail_label(I) | CaseLabels]; + #icode_type{} -> + [type_true_label(I), type_false_label(I)]; + #icode_call{} -> + case call_continuation(I) of [] -> []; L when is_integer(L) -> [L] end + ++ + case call_fail_label(I) of [] -> []; L when is_integer(L) -> [L] end; + #icode_begin_try{} -> + [begin_try_successor(I), begin_try_label(I)]; + #icode_fail{} -> + case fail_label(I) of [] -> []; L when is_integer(L) -> [L] end; + #icode_enter{} -> []; + #icode_return{} -> []; + %% the following are included here for handling linear code + #icode_move{} -> []; + #icode_begin_handler{} -> [] + end. + +%% +%% @doc Returns the fail labels of an Icode instruction. +%% + +-spec fails_to(icode_instr()) -> [icode_lbl()]. + +fails_to(I) -> + case I of + #icode_switch_val{} -> [switch_val_fail_label(I)]; + #icode_switch_tuple_arity{} -> [switch_tuple_arity_fail_label(I)]; + #icode_call{} -> + case call_fail_label(I) of [] -> []; L when is_integer(L) -> [L] end; + #icode_begin_try{} -> [begin_try_label(I)]; % just for safety + #icode_fail{} -> + case fail_label(I) of [] -> []; L when is_integer(L) -> [L] end; + #icode_if{} -> []; % XXX: Correct? + #icode_enter{} -> []; % XXX: Correct? + #icode_goto{} -> []; + #icode_type{} -> []; % XXX: Correct? + #icode_return{} -> [] + end. + +%% +%% @doc Redirects jumps from label Old to label New. +%% If the instruction does not jump to Old, it remains unchanged. +%% The New label can be the special [] label used for calls with +%% fall-throughs. +%% + +-spec redirect_jmp(icode_instr(), icode_lbl(), [] | icode_lbl()) -> icode_instr(). + +redirect_jmp(Jmp, ToOld, ToOld) -> + Jmp; % no need to do anything +redirect_jmp(Jmp, ToOld, ToNew) -> + NewI = + case Jmp of + #icode_if{} -> + NewJmp = case if_true_label(Jmp) of + ToOld -> if_true_label_update(Jmp, ToNew); + _ -> Jmp + end, + case if_false_label(NewJmp) of + ToOld -> if_false_label_update(NewJmp, ToNew); + _ -> NewJmp + end; + #icode_goto{} -> + case goto_label(Jmp) of + ToOld -> Jmp#icode_goto{label=ToNew}; + _ -> Jmp + end; + #icode_switch_val{} -> + NewJmp = case switch_val_fail_label(Jmp) of + ToOld -> switch_val_fail_label_update(Jmp, ToNew); + _ -> Jmp + end, + Cases = [case Pair of + {Val,ToOld} -> {Val,ToNew}; + Unchanged -> Unchanged + end || Pair <- switch_val_cases(NewJmp)], + NewJmp#icode_switch_val{cases = Cases}; + #icode_switch_tuple_arity{} -> + NewJmp = case switch_tuple_arity_fail_label(Jmp) of + ToOld -> + Jmp#icode_switch_tuple_arity{fail_label=ToNew}; + _ -> Jmp + end, + Cases = [case Pair of + {Val,ToOld} -> {Val,ToNew}; + Unchanged -> Unchanged + end || Pair <- switch_tuple_arity_cases(NewJmp)], + NewJmp#icode_switch_tuple_arity{cases = Cases}; + #icode_type{} -> + NewJmp = case type_true_label(Jmp) of + ToOld -> Jmp#icode_type{true_label=ToNew}; + _ -> Jmp + end, + case type_false_label(NewJmp) of + ToOld -> NewJmp#icode_type{false_label=ToNew}; + _ -> NewJmp + end; + #icode_call{} -> + NewCont = case call_continuation(Jmp) of + ToOld -> ToNew; + OldCont -> OldCont + end, + NewFail = case call_fail_label(Jmp) of + ToOld -> ToNew; + OldFail -> OldFail + end, + Jmp#icode_call{continuation = NewCont, + fail_label = NewFail}; + #icode_begin_try{} -> + NewLabl = case begin_try_label(Jmp) of + ToOld -> ToNew; + OldLab -> OldLab + end, + NewSucc = case begin_try_successor(Jmp) of + ToOld -> ToNew; + OldSucc -> OldSucc + end, + Jmp#icode_begin_try{label=NewLabl, successor=NewSucc}; + #icode_fail{} -> + case fail_label(Jmp) of + ToOld -> Jmp#icode_fail{fail_label=ToNew}; + _ -> Jmp + end + end, + simplify_branch(NewI). + +%% +%% @doc Turns a branch into a goto if it has only one successor and it +%% is safe to do so. +%% + +-spec simplify_branch(icode_instr()) -> icode_instr(). + +simplify_branch(I) -> + case ordsets:from_list(successors(I)) of + [Label] -> + Goto = mk_goto(Label), + case I of + #icode_type{} -> Goto; + #icode_if{} -> Goto; + #icode_switch_tuple_arity{} -> Goto; + #icode_switch_val{} -> Goto; + _ -> I + end; + _ -> I + end. + +%% +%% Is this an unconditional jump (causes a basic block not to have a +%% fallthrough successor). +%% + +%% is_uncond(I) -> +%% case I of +%% #icode_goto{} -> true; +%% #icode_fail{} -> true; +%% #icode_enter{} -> true; +%% #icode_return{} -> true; +%% #icode_call{} -> +%% case call_fail_label(I) of +%% [] -> +%% case call_continuation(I) of +%% [] -> false; +%% _ -> true +%% end; +%% _ -> true +%% end; +%% _ -> false +%% end. + +%% @spec is_branch(icode_instr()) -> boolean() +%% +%% @doc Succeeds if the Icode instruction is a branch. I.e. a +%% (possibly conditional) discontinuation of linear control flow. +%% @end + +-spec is_branch(icode_instr()) -> boolean(). +is_branch(Instr) -> + case Instr of + #icode_if{} -> true; + #icode_switch_val{} -> true; + #icode_switch_tuple_arity{} -> true; + #icode_type{} -> true; + #icode_goto{} -> true; + #icode_fail{} -> true; + #icode_call{} -> + case call_fail_label(Instr) of + [] -> call_continuation(Instr) =/= []; + _ -> true + end; + #icode_enter{} -> true; + #icode_return{} -> true; + #icode_begin_try{} -> true; + %% false cases below + #icode_move{} -> false; + #icode_begin_handler{} -> false; + #icode_end_try{} -> false; + #icode_comment{} -> false; + #icode_label{} -> false; + #icode_phi{} -> false + end. + +%% +%% @doc Makes a new variable. +%% + +-spec mk_new_var() -> icode_var(). +mk_new_var() -> + mk_var(hipe_gensym:get_next_var(icode)). + +%% +%% @doc Makes a new fp variable. +%% + +-spec mk_new_fvar() -> icode_fvar(). +mk_new_fvar() -> + mk_fvar(hipe_gensym:get_next_var(icode)). + +%% +%% @doc Makes a new register. +%% + +-spec mk_new_reg() -> icode_reg(). +mk_new_reg() -> + mk_reg(hipe_gensym:get_next_var(icode)). + +%% +%% @doc Makes a new label. +%% + +-spec mk_new_label() -> #icode_label{}. +mk_new_label() -> + mk_label(hipe_gensym:get_next_label(icode)). + +%% %% +%% %% @doc Makes a bunch of move operations. +%% %% +%% +%% -spec mk_moves([_], [_]) -> [#icode_move{}]. +%% mk_moves([], []) -> +%% []; +%% mk_moves([X|Xs], [Y|Ys]) -> +%% [mk_move(X, Y) | mk_moves(Xs, Ys)]. + +%% +%% Makes a series of element operations. +%% + +%% mk_elements(_, []) -> +%% []; +%% mk_elements(Tuple, [X|Xs]) -> +%% [mk_primop([X], #unsafe_element{index=length(Xs)+1}, [Tuple]) | +%% mk_elements(Tuple, Xs)]. + +%% +%% @doc Removes comments from Icode. +%% + +-spec strip_comments(#icode{}) -> #icode{}. +strip_comments(ICode) -> + icode_code_update(ICode, no_comments(icode_code(ICode))). + +%% The following spec is underspecified: the resulting list does not +%% contain any #comment{} instructions +-spec no_comments(icode_instrs()) -> icode_instrs(). +no_comments([]) -> + []; +no_comments([I|Xs]) -> + case is_comment(I) of + true -> no_comments(Xs); + false -> [I|no_comments(Xs)] + end. + +%%----------------------------------------------------------------------- + +%% @doc True if an Icode instruction is safe (can be removed if the +%% result is not used). Note that pure control flow instructions +%% cannot be regarded as safe, as they are not defining anything. + +-spec is_safe(icode_instr()) -> boolean(). + +is_safe(Instr) -> + case Instr of + %% Instructions that are safe, or might be safe to remove. + #icode_move{} -> true; + #icode_phi{} -> true; + #icode_begin_handler{} -> true; + #icode_call{} -> + case call_fun(Instr) of + {M,F,A} -> + erl_bifs:is_safe(M,F,A); + Op -> + hipe_icode_primops:is_safe(Op) + end; + %% Control flow instructions. + #icode_if{} -> false; + #icode_switch_val{} -> false; + #icode_switch_tuple_arity{} -> false; + #icode_type{} -> false; + #icode_goto{} -> false; + #icode_label{} -> false; + %% Returning instructions without defines. + #icode_return{} -> false; + #icode_fail{} -> false; + #icode_enter{} -> false; + %% Internal auxiliary instructions that should not be removed + %% unless you really know what you are doing. + #icode_comment{} -> false; + #icode_begin_try{} -> false; + #icode_end_try{} -> false + end. + +%%----------------------------------------------------------------------- + +-spec highest_var(icode_instrs()) -> non_neg_integer(). +highest_var(Instrs) -> + highest_var(Instrs, 0). + +-spec highest_var(icode_instrs(), non_neg_integer()) -> non_neg_integer(). +highest_var([I|Is], Max) -> + Defs = defines(I), + Uses = uses(I), + highest_var(Is, new_max(Defs++Uses, Max)); +highest_var([], Max) -> + Max. + +-spec new_max([#icode_variable{}], non_neg_integer()) -> non_neg_integer(). +new_max([V|Vs], Max) -> + VName = + case is_var(V) of + true -> + var_name(V); + false -> + case is_fvar(V) of + true -> + fvar_name(V); + _ -> + reg_name(V) + end + end, + new_max(Vs, erlang:max(VName, Max)); +new_max([], Max) when is_integer(Max) -> + Max. + +%%----------------------------------------------------------------------- + +-spec highest_label(icode_instrs()) -> icode_lbl(). +highest_label(Instrs) -> + highest_label(Instrs, 0). + +-spec highest_label(icode_instrs(), icode_lbl()) -> icode_lbl(). +highest_label([I|Is], Max) -> + case is_label(I) of + true -> + L = label_name(I), + NewMax = erlang:max(L, Max), + highest_label(Is, NewMax); + false -> + highest_label(Is, Max) + end; +highest_label([], Max) when is_integer(Max) -> + Max. + +%%----------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl new file mode 100644 index 0000000000..65deaf6d7c --- /dev/null +++ b/lib/hipe/icode/hipe_icode.hrl @@ -0,0 +1,188 @@ +%% +%% %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% +%% +%%===================================================================== +%% +%% Contains type and record definitions for all Icode data structures. +%% +%%===================================================================== + +%%--------------------------------------------------------------------- +%% THIS DOES NOT REALLY BELONG HERE -- PLEASE REMOVE ASAP! +%%--------------------------------------------------------------------- + +-type ordset(T) :: [T]. + +%%--------------------------------------------------------------------- +%% Include files needed for the compilation of this header file +%%--------------------------------------------------------------------- + +-include("../misc/hipe_consttab.hrl"). + +%%--------------------------------------------------------------------- +%% Icode argument types +%%--------------------------------------------------------------------- + +-type simple_const() :: atom() | [] | integer() | float(). +-type structured_const() :: list() | tuple(). + +-type icode_lbl() :: non_neg_integer(). + +%%--------------------------------------------------------------------- +%% Icode records +%%--------------------------------------------------------------------- + +-record(flat, {value :: simple_const() | structured_const() | binary()}). + +-record(icode_const, {value :: #flat{}}). + +-type variable_annotation() :: {atom(), any(), fun((any()) -> string())}. + +-record(icode_variable, {name :: non_neg_integer(), + kind :: 'var' | 'reg' | 'fvar', + annotation = [] :: [] | variable_annotation()}). + +%%--------------------------------------------------------------------- +%% Type declarations for Icode instructions +%%--------------------------------------------------------------------- + +-type icode_if_op() :: '>' | '<' | '>=' | '=<' | '=:=' | '=/=' | '==' | '/=' + | 'fixnum_eq' | 'fixnum_neq' | 'fixnum_lt' + | 'fixnum_le' | 'fixnum_ge' | 'fixnum_gt' + | 'suspend_msg_timeout'. + +-type icode_type_test() :: 'atom' | 'bignum' | 'binary' | 'bitrst' | 'boolean' + | 'cons' | 'constant' | 'fixnum' | 'float' + | 'function' | 'function2' | 'integer' | 'list' | 'nil' + | 'number' | 'pid' | 'port' | 'reference' | 'tuple' + | {'atom', atom()} | {'integer', integer()} + | {'record', atom(), non_neg_integer()} + | {'tuple', non_neg_integer()}. + +-type icode_primop() :: atom() | tuple(). % XXX: temporarily, I hope +-type icode_funcall() :: mfa() | icode_primop(). + +-type icode_var() :: #icode_variable{kind::'var'}. +-type icode_reg() :: #icode_variable{kind::'reg'}. +-type icode_fvar() :: #icode_variable{kind::'fvar'}. +-type icode_argument() :: #icode_const{} | #icode_variable{}. +-type icode_term_arg() :: icode_var() | #icode_const{}. + +-type icode_switch_case() :: {#icode_const{}, icode_lbl()}. + +-type icode_call_type() :: 'local' | 'primop' | 'remote'. +-type icode_exit_class() :: 'error' | 'exit' | 'rethrow' | 'throw'. + +-type icode_comment_text() :: atom() | string() | {atom(), term()}. + +-type icode_info() :: [{'arg_types', [erl_types:erl_type()]}]. + +%%--------------------------------------------------------------------- +%% Icode instructions +%%--------------------------------------------------------------------- + +-record(icode_label, {name :: icode_lbl()}). + +-record(icode_if, {op :: icode_if_op(), + args :: [icode_term_arg()], + true_label :: icode_lbl(), + false_label :: icode_lbl(), + p :: float()}). + +-record(icode_switch_val, {term :: icode_var(), + fail_label :: icode_lbl(), + length :: non_neg_integer(), + cases :: [icode_switch_case()]}). + +-record(icode_switch_tuple_arity, {term :: icode_var(), + fail_label :: icode_lbl(), + length :: non_neg_integer(), + cases :: [icode_switch_case()]}). + + +-record(icode_type, {test :: icode_type_test(), + args :: [icode_term_arg()], + true_label :: icode_lbl(), + false_label :: icode_lbl(), + p :: float()}). + +-record(icode_goto, {label :: icode_lbl()}). + +-record(icode_move, {dst :: #icode_variable{}, + src :: #icode_variable{} | #icode_const{}}). + +-record(icode_phi, {dst :: #icode_variable{}, + id :: #icode_variable{}, + arglist :: [{icode_lbl(), #icode_variable{}}]}). + +-record(icode_call, {dstlist :: [#icode_variable{}], + 'fun' :: icode_funcall(), + args :: [icode_argument()], + type :: icode_call_type(), + continuation :: [] | icode_lbl(), + fail_label = [] :: [] | icode_lbl(), + in_guard = false :: boolean()}). + +-record(icode_enter, {'fun' :: icode_funcall(), + args :: [icode_term_arg()], + type :: icode_call_type()}). + +-record(icode_return, {vars :: [icode_var()]}). + +-record(icode_begin_try, {label :: icode_lbl(), successor :: icode_lbl()}). + +-record(icode_end_try, {}). + +-record(icode_begin_handler, {dstlist :: [icode_var()]}). + +%% TODO: Remove [] from fail_label +-record(icode_fail, {class :: icode_exit_class(), + args :: [icode_term_arg()], + fail_label = [] :: [] | icode_lbl()}). + +-record(icode_comment, {text :: icode_comment_text()}). + +%%--------------------------------------------------------------------- +%% Icode instructions +%%--------------------------------------------------------------------- + +-type icode_instr() :: #icode_begin_handler{} | #icode_begin_try{} + | #icode_call{} | #icode_comment{} | #icode_end_try{} + | #icode_enter{} | #icode_fail{} + | #icode_goto{} | #icode_if{} | #icode_label{} + | #icode_move{} | #icode_phi{} | #icode_return{} + | #icode_switch_tuple_arity{} | #icode_switch_val{} + | #icode_type{}. +-type icode_instrs() :: [icode_instr()]. + +%%--------------------------------------------------------------------- +%% The Icode data structure +%%--------------------------------------------------------------------- + +-record(icode, {'fun' :: mfa(), + params :: [icode_var()], + is_closure :: boolean(), + closure_arity :: arity(), + is_leaf :: boolean(), + code = [] :: icode_instrs(), + data :: hipe_consttab(), + var_range :: {non_neg_integer(), non_neg_integer()}, + label_range :: {icode_lbl(), icode_lbl()}, + info = [] :: icode_info()}). + +%%--------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_bincomp.erl b/lib/hipe/icode/hipe_icode_bincomp.erl new file mode 100644 index 0000000000..6f694f2bce --- /dev/null +++ b/lib/hipe/icode/hipe_icode_bincomp.erl @@ -0,0 +1,178 @@ +%%% -*- erlang-indent-level: 2 -*- +%%% +%%% %CopyrightBegin% +%%% +%%% Copyright Ericsson AB 2006-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_icode_bincomp.erl +%%% Author : Per Gustafsson +%%% Description : +%%% +%%% Created : 12 Sep 2005 by Per Gustafsson +%%%------------------------------------------------------------------- + +-module(hipe_icode_bincomp). + +-export([cfg/1]). + +%%-------------------------------------------------------------------- + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +%%-------------------------------------------------------------------- + +-spec cfg(cfg()) -> cfg(). + +cfg(Cfg1) -> + StartLbls = ordsets:from_list([hipe_icode_cfg:start_label(Cfg1)]), + find_bs_get_integer(StartLbls, Cfg1, StartLbls). + +find_bs_get_integer([Lbl|Rest], Cfg, Visited) -> + BB = hipe_icode_cfg:bb(Cfg, Lbl), + Last = hipe_bb:last(BB), + NewCfg = + case ok(Last, Cfg) of + {ok,{Type, FakeFail, RealFail, SuccLbl, MsIn, MsOut}} -> + {Cont, Info, OldLbl, LastMsOut} = + collect_info(SuccLbl, Cfg, [Type], Lbl, RealFail, MsOut), + update_code(Lbl, OldLbl, Cfg, Info, Cont, FakeFail, MsIn, LastMsOut); + not_ok -> + Cfg + end, + Succs = ordsets:from_list(hipe_icode_cfg:succ(NewCfg, Lbl)), + NewSuccs = ordsets:subtract(Succs, Visited), + NewLbls = ordsets:union(NewSuccs, Rest), + NewVisited = ordsets:union(NewSuccs, Visited), + find_bs_get_integer(NewLbls, NewCfg, NewVisited); +find_bs_get_integer([], Cfg, _) -> + Cfg. + +ok(I, Cfg) -> + case hipe_icode:is_call(I) of + true -> + case hipe_icode:call_fun(I) of + {hipe_bs_primop, {bs_get_integer, Size, Flags}} when (Flags band 6) =:= 0 -> + case {hipe_icode:call_dstlist(I), hipe_icode:call_args(I)} of + {[Dst, MsOut] = DstList, [MsIn]} -> + Cont = hipe_icode:call_continuation(I), + FirstFail = hipe_icode:call_fail_label(I), + FirstFailBB = hipe_icode_cfg:bb(Cfg, FirstFail), + case check_for_restore_block(FirstFailBB, DstList) of + {restore_block, RealFail} -> + {ok, {{Dst, Size}, FirstFail, RealFail, Cont, MsIn, MsOut}}; + not_restore_block -> + not_ok + end; + _ -> + not_ok + end; + _ -> + not_ok + end; + false -> + not_ok + end. + +check_for_restore_block(FirstFailBB, DefVars) -> + Moves = hipe_bb:butlast(FirstFailBB), + case [Instr || Instr <- Moves, is_badinstr(Instr, DefVars)] of + [] -> + Last = hipe_bb:last(FirstFailBB), + case hipe_icode:is_goto(Last) of + true -> + {restore_block, hipe_icode:goto_label(Last)}; + false -> + not_restore_block + end; + [_|_] -> + not_restore_block + end. + +is_badinstr(Instr, DefVars) -> + not(hipe_icode:is_move(Instr) andalso + lists:member(hipe_icode:move_dst(Instr), DefVars)). + +collect_info(Lbl, Cfg, Acc, OldLbl, FailLbl, MsOut) -> + case do_collect_info(Lbl, Cfg, Acc, FailLbl, MsOut) of + done -> + {Lbl, Acc, OldLbl, MsOut}; + {cont, NewAcc, NewLbl, NewMsOut} -> + collect_info(NewLbl, Cfg, NewAcc, Lbl, FailLbl, NewMsOut) + end. + +do_collect_info(Lbl, Cfg, Acc, FailLbl, MsOut) -> + BB = hipe_icode_cfg:bb(Cfg,Lbl), + case hipe_bb:code(BB) of + [I] -> + case hipe_icode_cfg:pred(Cfg,Lbl) of + [_] -> + case ok(I, Cfg) of + {ok, {Type,_FakeFail,FailLbl,SuccLbl,MsOut,NewMsOut}} -> + NewAcc = [Type|Acc], + MaxSize = hipe_rtl_arch:word_size() * 8 - 5, + case calc_size(NewAcc) of + Size when Size =< MaxSize -> + {cont,NewAcc,SuccLbl,NewMsOut}; + _ -> + done + end; + _ -> + done + end; + _ -> + done + end; + _ -> + done + end. + +calc_size([{_,Size}|Rest]) when is_integer(Size) -> + Size + calc_size(Rest); +calc_size([]) -> 0. + +update_code(_Lbl, _, Cfg, [_Info], _Cont, _LastFail, _MsIn, _MsOut) -> + Cfg; +update_code(Lbl, OldLbl, Cfg, Info, Cont, LastFail, MsIn, MsOut) -> + BB = hipe_icode_cfg:bb(Cfg, Lbl), + ButLast = hipe_bb:butlast(BB), + NewVar = hipe_icode:mk_new_var(), + Size = calc_size(Info), + NewLast = + hipe_icode:mk_primop([NewVar,MsOut], + {hipe_bs_primop, {bs_get_integer,Size,0}}, + [MsIn], + OldLbl, + LastFail), + NewBB = hipe_bb:mk_bb(ButLast++[NewLast]), + NewCfg = hipe_icode_cfg:bb_add(Cfg, Lbl, NewBB), + fix_rest(Info, NewVar, OldLbl, Cont, NewCfg). + +fix_rest(Info, Var, Lbl, Cont, Cfg) -> + ButLast = make_butlast(Info, Var), + Last = hipe_icode:mk_goto(Cont), + NewBB = hipe_bb:mk_bb(ButLast++[Last]), + hipe_icode_cfg:bb_add(Cfg, Lbl, NewBB). + +make_butlast([{Res,_Size}], Var) -> + [hipe_icode:mk_move(Res, Var)]; +make_butlast([{Res, Size}|Rest], Var) -> + NewVar = hipe_icode:mk_new_var(), + [hipe_icode:mk_primop([Res], 'band', + [Var, hipe_icode:mk_const((1 bsl Size)-1)]), + hipe_icode:mk_primop([NewVar], 'bsr', [Var, hipe_icode:mk_const(Size)]) + |make_butlast(Rest, NewVar)]. diff --git a/lib/hipe/icode/hipe_icode_callgraph.erl b/lib/hipe/icode/hipe_icode_callgraph.erl new file mode 100644 index 0000000000..95182fc002 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_callgraph.erl @@ -0,0 +1,217 @@ +%% -*- 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_icode_callgraph.erl +%% Author : Tobias Lindahl +%% Purpose : Creates a call graph to find out in what order functions +%% in a module have to be compiled to gain best information +%% in hipe_icode_type.erl. +%% +%% Created : 7 Jun 2004 by Tobias Lindahl +%% +%% $Id$ +%%----------------------------------------------------------------------- +-module(hipe_icode_callgraph). + +-export([construct/1, + get_called_modules/1, + to_list/1, + construct_callgraph/1]). + +-define(NO_UNUSED, true). + +-ifndef(NO_UNUSED). +-export([is_empty/1, take_first/1, pp/1]). +-endif. + +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). + +%%------------------------------------------------------------------------ + +-type mfa_icode() :: {mfa(), #icode{}}. + +-record(icode_callgraph, {codedict :: dict(), ordered_sccs :: [[atom()]]}). + +%%------------------------------------------------------------------------ +%% Exported functions +%%------------------------------------------------------------------------ + +-spec construct([mfa_icode()]) -> #icode_callgraph{}. + +construct(List) -> + Calls = get_local_calls(List), + %% io:format("Calls: ~p\n", [lists:keysort(1, Calls)]), + Edges = get_edges(Calls), + %% io:format("Edges: ~p\n", [Edges]), + DiGraph = hipe_digraph:from_list(Edges), + Nodes = ordsets:from_list([MFA || {MFA, _} <- List]), + DiGraph1 = hipe_digraph:add_node_list(Nodes, DiGraph), + SCCs = hipe_digraph:reverse_preorder_sccs(DiGraph1), + #icode_callgraph{codedict = dict:from_list(List), ordered_sccs = SCCs}. + +-spec construct_callgraph([mfa_icode()]) -> hipe_digraph:hdg(). + +construct_callgraph(List) -> + Calls = get_local_calls2(List), + Edges = get_edges(Calls), + hipe_digraph:from_list(Edges). + +-spec to_list(#icode_callgraph{}) -> [mfa_icode()]. + +to_list(#icode_callgraph{codedict = Dict, ordered_sccs = SCCs}) -> + FlatList = lists:flatten(SCCs), + [{Mod, dict:fetch(Mod, Dict)} || Mod <- FlatList]. + +%%------------------------------------------------------------------------ + +-ifndef(NO_UNUSED). + +-spec is_empty(#icode_callgraph{}) -> boolean(). + +is_empty(#icode_callgraph{ordered_sccs = SCCs}) -> + SCCs =:= []. + +-spec take_first(#icode_callgraph{}) -> {[mfa_icode()], #icode_callgraph{}}. + +take_first(#icode_callgraph{codedict = Dict, ordered_sccs = [H|T]} = CG) -> + SCCCode = [{Mod, dict:fetch(Mod, Dict)} || Mod <- H], + {SCCCode, CG#icode_callgraph{ordered_sccs = T}}. + +-spec pp(#icode_callgraph{}) -> 'ok'. + +pp(#icode_callgraph{ordered_sccs = SCCs}) -> + io:format("Callgraph ~p\n", [SCCs]). +-endif. + +%%------------------------------------------------------------------------ +%% Get the modules called from this module + +-spec get_called_modules([mfa_icode()]) -> ordset(atom()). + +get_called_modules(List) -> + get_remote_calls(List, []). + +get_remote_calls([{_MFA, Icode}|Left], Acc) -> + CallSet = get_remote_calls_1(hipe_icode:icode_code(Icode), Acc), + get_remote_calls(Left, ordsets:union(Acc, CallSet)); +get_remote_calls([], Acc) -> + Acc. + +get_remote_calls_1([I|Left], Set) -> + NewSet = + case I of + #icode_call{} -> + case hipe_icode:call_type(I) of + remote -> + {M, _F, _A} = hipe_icode:call_fun(I), + ordsets:add_element(M, Set); + _ -> + Set + end; + #icode_enter{} -> + case hipe_icode:enter_type(I) of + remote -> + {M, _F, _A} = hipe_icode:enter_fun(I), + ordsets:add_element(M, Set); + _ -> + Set + end; + _ -> + Set + end, + get_remote_calls_1(Left, NewSet); +get_remote_calls_1([], Set) -> + Set. + +%%------------------------------------------------------------------------ +%% Find functions called (or entered) by each function. + +get_local_calls(List) -> + RemoveFun = fun ordsets:del_element/2, + get_local_calls(List, RemoveFun, []). + +get_local_calls2(List) -> + RemoveFun = fun(_,Set) -> Set end, + get_local_calls(List, RemoveFun, []). + +get_local_calls([{{_M, _F, _A} = MFA, Icode}|Left], RemoveFun, Acc) -> + CallSet = get_local_calls_1(hipe_icode:icode_code(Icode)), + %% Exclude recursive calls. + CallSet1 = RemoveFun(MFA, CallSet), + get_local_calls(Left, RemoveFun, [{MFA, CallSet1}|Acc]); +get_local_calls([], _RemoveFun, Acc) -> + Acc. + +get_local_calls_1(Icode) -> + get_local_calls_1(Icode, []). + +get_local_calls_1([I|Left], Set) -> + NewSet = + case I of + #icode_call{} -> + case hipe_icode:call_type(I) of + local -> + Fun = hipe_icode:call_fun(I), + ordsets:add_element(Fun, Set); + primop -> + case hipe_icode:call_fun(I) of + #mkfun{mfa = Fun} -> + ordsets:add_element(Fun, Set); + _ -> + Set + end; + remote -> + Set + end; + #icode_enter{} -> + case hipe_icode:enter_type(I) of + local -> + Fun = hipe_icode:enter_fun(I), + ordsets:add_element(Fun, Set); + primop -> + case hipe_icode:enter_fun(I) of + #mkfun{mfa = Fun} -> + ordsets:add_element(Fun, Set); + _ -> + Set + end; + remote -> + Set + end; + _ -> + Set + end, + get_local_calls_1(Left, NewSet); +get_local_calls_1([], Set) -> + Set. + +%%------------------------------------------------------------------------ +%% Find the edges in the callgraph. + +get_edges(Calls) -> + get_edges(Calls, []). + +get_edges([{MFA, Set}|Left], Edges) -> + EdgeList = [{MFA, X} || X <- Set], + EdgeSet = ordsets:from_list(EdgeList), + get_edges(Left, ordsets:union(EdgeSet, Edges)); +get_edges([], Edges) -> + Edges. diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl new file mode 100644 index 0000000000..9b4a10e273 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_cfg.erl @@ -0,0 +1,203 @@ +%% -*- erlang-indent-level: 2 -*- +%%====================================================================== +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% + +-module(hipe_icode_cfg). + +-export([bb/2, bb_add/3, + cfg_to_linear/1, + is_closure/1, + closure_arity/1, + linear_to_cfg/1, + labels/1, start_label/1, + pp/1, pp/2, + params/1, params_update/2, + pred/2, + redirect/4, + remove_trivial_bbs/1, remove_unreachable_code/1, + succ/2, + visit/2, is_visited/2, none_visited/0 + ]). +-export([postorder/1, reverse_postorder/1]). + +-define(ICODE_CFG, true). % needed by cfg.inc +%%-define(DO_ASSERT, true). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("../flow/hipe_bb.hrl"). +-include("../flow/cfg.hrl"). +-include("../flow/cfg.inc"). + +%%---------------------------------------------------------------------- +%% Prototypes for exported functions which are Icode specific +%%---------------------------------------------------------------------- + +-spec labels(cfg()) -> [icode_lbl()]. +-spec postorder(cfg()) -> [icode_lbl()]. +-spec reverse_postorder(cfg()) -> [icode_lbl()]. + +-spec is_visited(icode_lbl(), gb_set()) -> boolean(). +-spec visit(icode_lbl(), gb_set()) -> gb_set(). + +-spec bb(cfg(), icode_lbl()) -> 'not_found' | bb(). +-spec bb_add(cfg(), icode_lbl(), bb()) -> cfg(). +-spec pred(cfg(), icode_lbl()) -> [icode_lbl()]. +-spec succ(cfg(), icode_lbl()) -> [icode_lbl()]. +-spec redirect(cfg(), icode_lbl(), icode_lbl(), icode_lbl()) -> cfg(). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Interface to Icode +%% + +-spec linear_to_cfg(#icode{}) -> cfg(). + +linear_to_cfg(LinearIcode) -> + %% hipe_icode_pp:pp(Icode), + Code = hipe_icode:icode_code(LinearIcode), + IsClosure = hipe_icode:icode_is_closure(LinearIcode), + StartLabel = hipe_icode:label_name(hd(Code)), + CFG0 = mk_empty_cfg(hipe_icode:icode_fun(LinearIcode), + StartLabel, + hipe_icode:icode_data(LinearIcode), + IsClosure, + hipe_icode:icode_is_leaf(LinearIcode), + hipe_icode:icode_params(LinearIcode)), + CFG1 = info_update(CFG0, hipe_icode:icode_info(LinearIcode)), + CFG2 = case IsClosure of + true -> + closure_arity_update(CFG1, + hipe_icode:icode_closure_arity(LinearIcode)); + false -> + CFG1 + end, + ?opt_start_timer("Get BBs icode"), + FullCFG = take_bbs(Code, CFG2), + ?opt_stop_timer("Get BBs icode"), + FullCFG. + +%% remove_blocks(CFG, []) -> +%% CFG; +%% remove_blocks(CFG, [Lbl|Lbls]) -> +%% remove_blocks(bb_remove(CFG, Lbl), Lbls). + +-spec is_label(icode_instr()) -> boolean(). +is_label(Instr) -> + hipe_icode:is_label(Instr). + +label_name(Instr) -> + hipe_icode:label_name(Instr). + +mk_label(Name) -> + hipe_icode:mk_label(Name). + +mk_goto(Name) -> + hipe_icode:mk_goto(Name). + +branch_successors(Instr) -> + hipe_icode:successors(Instr). + +fails_to(Instr) -> + hipe_icode:fails_to(Instr). + +%% True if instr has no effect. +-spec is_comment(icode_instr()) -> boolean(). +is_comment(Instr) -> + hipe_icode:is_comment(Instr). + +%% True if instr is just a jump (no side-effects). +-spec is_goto(icode_instr()) -> boolean(). +is_goto(Instr) -> + hipe_icode:is_goto(Instr). + +-spec is_branch(icode_instr()) -> boolean(). +is_branch(Instr) -> + hipe_icode:is_branch(Instr). + +-spec is_pure_branch(icode_instr()) -> boolean(). +is_pure_branch(Instr) -> + case Instr of + #icode_if{} -> true; + #icode_goto{} -> true; + #icode_switch_val{} -> true; + #icode_switch_tuple_arity{} -> true; + #icode_type{} -> true; + %% false cases below -- XXX: are they correct? + #icode_label{} -> false; + #icode_move{} -> false; + #icode_phi{} -> false; + #icode_call{} -> false; + #icode_enter{} -> false; + #icode_return{} -> false; + #icode_begin_try{} -> false; + #icode_end_try{} -> false; + #icode_begin_handler{} -> false; + #icode_fail{} -> false; + #icode_comment{} -> false + end. + +-spec is_phi(icode_instr()) -> boolean(). +is_phi(I) -> + hipe_icode:is_phi(I). + +phi_remove_pred(I, Pred) -> + hipe_icode:phi_remove_pred(I, Pred). + +%% phi_redirect_pred(I, OldPred, NewPred) -> +%% hipe_icode:phi_redirect_pred(I, OldPred, NewPred). + +redirect_jmp(Jmp, ToOld, ToNew) -> + hipe_icode:redirect_jmp(Jmp, ToOld, ToNew). + +redirect_ops(_, CFG, _) -> %% We do not refer to labels in Icode ops. + CFG. + +%%---------------------------------------------------------------------------- + +-spec pp(cfg()) -> 'ok'. + +pp(CFG) -> + hipe_icode_pp:pp(cfg_to_linear(CFG)). + +-spec pp(io:device(), cfg()) -> 'ok'. + +pp(Dev, CFG) -> + hipe_icode_pp:pp(Dev, cfg_to_linear(CFG)). + +%%---------------------------------------------------------------------------- + +-spec cfg_to_linear(cfg()) -> #icode{}. +cfg_to_linear(CFG) -> + Code = linearize_cfg(CFG), + IsClosure = is_closure(CFG), + Icode = hipe_icode:mk_icode(function(CFG), + params(CFG), + IsClosure, + is_leaf(CFG), + Code, + data(CFG), + hipe_gensym:var_range(icode), + hipe_gensym:label_range(icode)), + Icode1 = hipe_icode:icode_info_update(Icode, info(CFG)), + case IsClosure of + true -> hipe_icode:icode_closure_arity_update(Icode1, closure_arity(CFG)); + false -> Icode1 + end. diff --git a/lib/hipe/icode/hipe_icode_coordinator.erl b/lib/hipe/icode/hipe_icode_coordinator.erl new file mode 100644 index 0000000000..a71e143192 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_coordinator.erl @@ -0,0 +1,274 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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_icode_coordinator.erl +%% Author : Per Gustafsson +%% Description : This module coordinates an Icode pass. +%% Created : 20 Feb 2007 by Per Gustafsson +%%--------------------------------------------------------------------- + +-module(hipe_icode_coordinator). + +-export([coordinate/4]). + +-include("hipe_icode.hrl"). + +%%--------------------------------------------------------------------- + +-define(MAX_CONCURRENT, erlang:system_info(schedulers)). + +%%--------------------------------------------------------------------- + +-spec coordinate(hipe_digraph:hdg(), [{mfa(),boolean()}], [mfa()], module()) -> + no_return(). + +coordinate(CG, Escaping, NonEscaping, Mod) -> + ServerPid = initialize_server(Escaping, Mod), + Clean = [MFA || {MFA, _} <- Escaping], + All = NonEscaping ++ Clean, + Restart = + fun (MFALists, PM) -> restart_funs(MFALists, PM, All, ServerPid) end, + LastAction = + fun (PM) -> last_action(PM, ServerPid, Mod, All) end, + coordinate({Clean,All}, CG, gb_trees:empty(), Restart, LastAction, ServerPid). + +coordinate(MFALists, CG, PM, Restart, LastAction, ServerPid) -> + case MFALists of + {[], []} -> + LastAction(PM), + ServerPid ! stop, + receive + {stop, Ans2Pid} -> + Ans2Pid ! {done, self()}, + exit(normal) + end; + _ -> ok + end, + receive + {stop, AnsPid} -> + ServerPid ! stop, + AnsPid ! {done, self()}, + exit(normal); + Message -> + {NewPM, NewMFALists} = + case Message of + {restart_call, MFA} -> + {PM, handle_restart_call(MFA, MFALists)}; + {ready, {MFA, Pid}} -> + handle_ready(MFA, Pid, MFALists, PM); + {restart_done, MFA} -> + {PM, handle_restart_done(MFA, MFALists, CG)}; + {no_change_done, MFA} -> + {PM, handle_no_change_done(MFA, MFALists)} + end, + coordinate(Restart(NewMFALists, NewPM), CG, NewPM, Restart, + LastAction, ServerPid) + end. + +handle_restart_call(MFA, {Queue, Busy} = QB) -> + case lists:member(MFA, Queue) of + true -> + QB; + false -> + {[MFA|Queue], Busy} + end. + +handle_ready(MFA, Pid, {Queue, Busy}, PM) -> + {gb_trees:insert(MFA, Pid, PM), {Queue, Busy -- [MFA]}}. + +handle_restart_done(MFA, {Queue, Busy}, CG) -> + Restarts = hipe_digraph:get_parents(MFA, CG), + {ordsets:from_list(Restarts ++ Queue), Busy -- [MFA]}. + +handle_no_change_done(MFA, {Queue, Busy}) -> + {Queue, Busy -- [MFA]}. + +last_action(PM, ServerPid, Mod, All) -> + lists:foreach(fun (MFA) -> + gb_trees:get(MFA, PM) ! {done, final_funs(ServerPid, Mod)}, + receive + {done_rewrite, MFA} -> ok + end + end, All), + ok. + +restart_funs({Queue, Busy} = QB, PM, All, ServerPid) -> + case ?MAX_CONCURRENT - length(Busy) of + X when is_integer(X), X > 0 -> + Possible = [Pos || Pos <- Queue, (not lists:member(Pos, Busy))], + Restarts = lists:sublist(Possible, X), + lists:foreach(fun (MFA) -> + restart_fun(MFA, PM, All, ServerPid) + end, Restarts), + {Queue -- Restarts, Busy ++ Restarts}; + X when is_integer(X) -> + QB + end. + +initialize_server(Escaping, Mod) -> + Pid = spawn_link(fun () -> info_server(Mod) end), + lists:foreach(fun ({MFA, _}) -> Pid ! {set_escaping, MFA} end, Escaping), + Pid. + +safe_get_args(MFA, Cfg, Pid, Mod) -> + Mod:replace_nones(get_args(MFA, Cfg, Pid)). + +get_args(MFA, Cfg, Pid) -> + Ref = make_ref(), + Pid ! {get_call, MFA, Cfg, self(), Ref}, + receive + {Ref, Types} -> + Types + end. + +safe_get_res(MFA, Pid, Mod) -> + Mod:replace_nones(get_res(MFA, Pid)). + +get_res(MFA, Pid) -> + Ref = make_ref(), + Pid ! {get_return, MFA, self(), Ref}, + receive + {Ref, Types} -> + Types + end. + +update_return_type(MFA, NewType, Pid) -> + Ref = make_ref(), + Pid ! {update_return, MFA, NewType, self(), Ref}, + receive + {Ref, Ans} -> + Ans + end. + +update_call_type(MFA, NewTypes, Pid) -> + Ref = make_ref(), + Pid ! {update_call, MFA, NewTypes, self(), Ref}, + receive + {Ref, Ans} -> + Ans + end. + +restart_fun(MFA, PM, All, ServerPid) -> + gb_trees:get(MFA, PM) ! {analyse, analysis_funs(All, ServerPid)}, + ok. + +analysis_funs(All, Pid) -> + Self = self(), + ArgsFun = fun (MFA, Cfg) -> get_args(MFA, Cfg, Pid) end, + GetResFun = fun (MFA, Args) -> + case lists:member(MFA, All) of + true -> + case update_call_type(MFA, Args, Pid) of + do_restart -> + Self ! {restart_call, MFA}, + ok; + no_change -> + ok + end; + false -> + ok + end, + [Ans] = get_res(MFA, Pid), + Ans + end, + FinalFun = fun (MFA, RetTypes) -> + case update_return_type(MFA, RetTypes, Pid) of + do_restart -> + Self ! {restart_done, MFA}, + ok; + no_change -> + Self ! {no_change_done, MFA}, + ok + end + end, + {ArgsFun, GetResFun, FinalFun}. + +final_funs(Pid,Mod) -> + ArgsFun = fun (MFA, Cfg) -> safe_get_args(MFA, Cfg, Pid, Mod) end, + GetResFun = fun (MFA, _) -> + [Ans] = safe_get_res(MFA, Pid, Mod), + Ans + end, + FinalFun = fun (_, _) -> ok end, + {ArgsFun, GetResFun, FinalFun}. + +info_server(Mod) -> + info_server_loop(gb_trees:empty(), gb_trees:empty(), Mod). + +info_server_loop(CallInfo, ReturnInfo, Mod) -> + receive + {update_return, MFA, NewInfo, Pid, Ref} -> + NewReturnInfo = handle_update(MFA, ReturnInfo, NewInfo, Pid, Ref, Mod), + info_server_loop(CallInfo, NewReturnInfo, Mod); + {update_call, MFA, NewInfo, Pid, Ref} -> + NewCallInfo = handle_update(MFA, CallInfo, NewInfo, Pid, Ref, Mod), + info_server_loop(NewCallInfo, ReturnInfo, Mod); + {get_return, MFA, Pid, Ref} -> + Ans = + case gb_trees:lookup(MFA, ReturnInfo) of + none -> + Mod:return_none(); + {value, TypesComp} -> + Mod:return__info((TypesComp)) + end, + Pid ! {Ref, Ans}, + info_server_loop(CallInfo, ReturnInfo, Mod); + {get_call, MFA, Cfg, Pid, Ref} -> + Ans = + case gb_trees:lookup(MFA, CallInfo) of + none -> + Mod:return_none_args(Cfg, MFA); + {value, escaping} -> + Mod:return_any_args(Cfg, MFA); + {value, TypesComp} -> + Mod:return__info(TypesComp) + end, + Pid ! {Ref, Ans}, + info_server_loop(CallInfo, ReturnInfo, Mod); + {set_escaping, MFA} -> + NewCallInfo = gb_trees:enter(MFA, escaping, CallInfo), + info_server_loop(NewCallInfo, ReturnInfo, Mod); + stop -> + ok + end. + +handle_update(MFA, Tree, NewInfo, Pid, Ref, Mod) -> + ResType = + case gb_trees:lookup(MFA, Tree) of + none -> + %% io:format("First Type: ~w ~w~n", [NewType, MFA]), + Pid ! {Ref, do_restart}, + Mod:new__info(NewInfo); + {value, escaping} -> + Pid ! {Ref, no_change}, + escaping; + {value, OldInfo} -> + %% io:format("New Type: ~w ~w~n", [NewType, MFA]), + %% io:format("Old Type: ~w ~w~n", [OldType, MFA]), + case Mod:update__info(NewInfo, OldInfo) of + {true, Type} -> + Pid ! {Ref, no_change}, + Type; + {false, Type} -> + Pid ! {Ref, do_restart}, + Type + end + end, + gb_trees:enter(MFA, ResType, Tree). diff --git a/lib/hipe/icode/hipe_icode_ebb.erl b/lib/hipe/icode/hipe_icode_ebb.erl new file mode 100644 index 0000000000..966c4d7564 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_ebb.erl @@ -0,0 +1,30 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Icode version of extended basic blocks. +%% + +-module(hipe_icode_ebb). + +-define(CFG, hipe_icode_cfg). + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). +-include("../flow/ebb.inc"). diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl new file mode 100644 index 0000000000..787fb05415 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_exceptions.erl @@ -0,0 +1,474 @@ +%% -*- 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% +%% +%% ==================================================================== +%% Filename : hipe_icode_exceptions.erl +%% Module : hipe_icode_exceptions +%% Purpose : Rewrite calls in intermediate code to use Continuation +%% and Fail-To labels. +%% +%% Catch-instructions work as follows: +%% - A begin_try(FailLabel) starts a catch-region which +%% is ended by a corresponding end_try(FailLabel). +%% - The handler begins with a begin_handler(FailLabel). +%% +%% However, the begin/end instructions do not always appear +%% as parentheses around the section that they protect (in +%% linear Beam/Icode). Also, different begin_catch +%% instructions can reach the same basic blocks (which may +%% raise exceptions), due to code compation optimizations +%% in the Beam compiler, even though they have different +%% handlers. Because of this, a data flow analysis is +%% necessary to find out which catches may reach which +%% basic blocks. After that, we clone basic blocks as +%% needed to ensure that each block belongs to at most one +%% unique begin_catch. The Beam does not have this problem, +%% since it will find the correct catch-handler frame +%% pushed on the stack. (Note that since there can be no +%% tail-calls within a catch region, our dataflow analysis +%% for finding all catch-stacks is sure to terminate.) +%% +%% Finally, we can remove all special catch instructions +%% and rewrite calls within catch regions to use explicit +%% fail-to labels, which is the main point of all this. +%% Fail labels that were set before this pass are kept. +%% (Note that calls that have only a continuation label do +%% not always end their basic blocks. Adding a fail label +%% to such a call can thus force us to split the block.) +%% +%% Notes : As of November 2003, primops that do not fail in the +%% normal sense are allowed to have a fail-label even +%% before this pass. (Used for the mbox-empty + get_msg +%% primitive in receives.) +%% +%% Native floating point operations cannot fail in the +%% normal sense. Instead they throw a hardware exception +%% which will be caught by a special fp check error +%% instruction. These primops do not need a fail label even +%% in a catch. This pass checks for this with +%% hipe_icode_primops:fails/1. If a call cannot fail, no +%% fail label is added. +%% +%% Explicit fails (exit, error and throw) inside +%% a catch have to be handled. They have to build their +%% exit value and jump directly to the catch handler. An +%% alternative solution would be to have a new type of +%% fail instruction that takes a fail-to label... +%% +%% CVS: +%% $Id$ +%% ==================================================================== + +-module(hipe_icode_exceptions). + +-export([fix_catches/1]). + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +%%---------------------------------------------------------------------------- + +-spec fix_catches(#cfg{}) -> #cfg{}. + +fix_catches(CFG) -> + {Map, State} = build_mapping(find_catches(init_state(CFG))), + hipe_icode_cfg:remove_unreachable_code(get_cfg(rewrite(State, Map))). + +%% This finds the set of possible catch-stacks for each basic block + +find_catches(State) -> + find_catches(get_start_labels(State), + clear_visited(clear_changed(State))). + +find_catches([L|Ls], State0) -> + case is_visited(L, State0) of + true -> + find_catches(Ls, State0); + false -> + State1 = set_visited(L, State0), + Code = get_bb_code(L, State1), + Cs = get_new_catches_in(L, State1), + State2 = set_catches_in(L, Cs, State1), % memorize + Cs1 = catches_out(Code, Cs), + Ls1 = get_succ(L, State2) ++ Ls, + Cs0 = get_catches_out(L, State2), + if Cs1 =:= Cs0 -> + find_catches(Ls1, State2); + true -> + State3 = set_catches_out(L, Cs1, State2), + find_catches(Ls1, set_changed(State3)) + end + end; +find_catches([], State) -> + case is_changed(State) of + true -> + find_catches(State); + false -> + State + end. + +catches_out([I|Is], Cs) -> + catches_out(Is, catches_out_instr(I, Cs)); +catches_out([], Cs) -> + Cs. + +catches_out_instr(I, Cs) -> + case I of + #icode_begin_try{} -> + Id = hipe_icode:begin_try_label(I), + push_catch(Id, Cs); + #icode_end_try{} -> + pop_catch(Cs); + #icode_begin_handler{} -> + pop_catch(Cs); + _ -> + Cs + end. + + +%% This builds the mapping used for cloning + +build_mapping(State) -> + build_mapping(get_start_labels(State), clear_visited(State), + new_mapping()). + +build_mapping([L|Ls], State0, Map) -> + case is_visited(L, State0) of + true -> + build_mapping(Ls, State0, Map); + false -> + State1 = set_visited(L, State0), + Cs = list_of_catches(get_catches_in(L, State1)), % get memorized + {Map1, State2} = map_bb(L, Cs, State1, Map), + Ls1 = get_succ(L, State2) ++ Ls, + build_mapping(Ls1, State2, Map1) + end; +build_mapping([], State, Map) -> + {Map, State}. + +map_bb(_L, [_C], State, Map) -> + {Map, State}; +map_bb(L, [C | Cs], State, Map) -> + %% This block will be cloned - we need to create N-1 new labels. + %% The identity mapping will be used for the first element. + Map1 = new_catch_labels(Cs, L, Map), + State1 = set_catches_in(L, single_catch(C), State), % update catches in + Code = get_bb_code(L, State1), + State2 = clone(Cs, L, Code, State1, Map1), + {Map1, State2}. + +clone([C | Cs], L, Code, State, Map) -> + Ren = get_renaming(C, Map), + L1 = Ren(L), + State1 = set_bb_code(L1, Code, State), + State2 = set_catches_in(L1, single_catch(C), State1), % set catches in + clone(Cs, L, Code, State2, Map); +clone([], _L, _Code, State, _Map) -> + State. + +new_catch_labels([C | Cs], L, Map) -> + L1 = hipe_icode:label_name(hipe_icode:mk_new_label()), + Map1 = set_mapping(C, L, L1, Map), + new_catch_labels(Cs, L, Map1); +new_catch_labels([], _L, Map) -> + Map. + + +%% This does all the actual rewriting and cloning. + +rewrite(State, Map) -> + rewrite(get_start_labels(State), clear_visited(State), Map). + +rewrite([L|Ls], State0, Map) -> + case is_visited(L, State0) of + true -> + rewrite(Ls, State0, Map); + false -> + State1 = set_visited(L, State0), + Code = get_bb_code(L, State1), + Cs = list_of_catches(get_catches_in(L, State1)), % get memorized + State2 = rewrite_bb(L, Cs, Code, State1, Map), + Ls1 = get_succ(L, State2) ++ Ls, + rewrite(Ls1, State2, Map) + end; +rewrite([], State, _Map) -> + State. + +rewrite_bb(L, [C], Code, State, Map) -> + {Code1, State1} = rewrite_code(Code, C, State, Map), + set_bb_code(L, Code1, State1). + +rewrite_code(Is, C, State, Map) -> + rewrite_code(Is, C, State, Map, []). + +rewrite_code([I|Is], C, State, Map, As) -> + [C1] = list_of_catches(catches_out_instr(I, single_catch(C))), + case I of + #icode_begin_try{} -> + {I1, Is1, State1} = update_begin_try(I, Is, C, State, Map), + I2 = redirect_instr(I1, C, Map), + rewrite_code(Is1, C1, State1, Map, [I2 | As]); + #icode_end_try{} -> + rewrite_code(Is, C1, State, Map, As); + #icode_call{} -> + {I1, Is1, State1} = update_call(I, Is, C, State, Map), + I2 = redirect_instr(I1, C, Map), + rewrite_code(Is1, C1, State1, Map, [I2 | As]); + #icode_fail{} -> + {I1, Is1, State1} = update_fail(I, Is, C, State, Map), + I2 = redirect_instr(I1, C, Map), + rewrite_code(Is1, C1, State1, Map, [I2 | As]); + _ -> + I1 = redirect_instr(I, C, Map), + rewrite_code(Is, C1, State, Map, [I1 | As]) + end; +rewrite_code([], _C, State, _Map, As) -> + {lists:reverse(As), State}. + +redirect_instr(I, C, Map) -> + redirect_instr_1(I, hipe_icode:successors(I), get_renaming(C, Map)). + +redirect_instr_1(I, [L0 | Ls], Ren) -> + I1 = hipe_icode:redirect_jmp(I, L0, Ren(L0)), + redirect_instr_1(I1, Ls, Ren); +redirect_instr_1(I, [], _Ren) -> + I. + +update_begin_try(I, Is, _C, State0, _Map) -> + L = hipe_icode:begin_try_successor(I), + I1 = hipe_icode:mk_goto(L), + {I1, Is, State0}. + +update_call(I, Is, C, State0, Map) -> + case top_of_stack(C) of + [] -> + %% No active catch. Assume cont./fail labels are correct as is. + {I, Is, State0}; + L -> + %% Only update the fail label if the call *can* fail. + case hipe_icode_primops:fails(hipe_icode:call_fun(I)) of + true -> + %% We only update the fail label if it is not already set. + case hipe_icode:call_fail_label(I) of + [] -> + I1 = hipe_icode:call_set_fail_label(I, L), + %% Now the call will end the block, so we must put the rest of + %% the code (if nonempty) in a new block! + if Is =:= [] -> + {I1, Is, State0}; + true -> + L1 = hipe_icode:label_name(hipe_icode:mk_new_label()), + I2 = hipe_icode:call_set_continuation(I1, L1), + State1 = set_bb_code(L1, Is, State0), + State2 = set_catches_in(L1, single_catch(C), State1), + State3 = rewrite_bb(L1, [C], Is, State2, Map), + {I2, [], State3} + end; + _ when Is =:= [] -> + %% Something is very wrong if Is is not empty here. A call + %% with a fail label should have ended its basic block. + {I, Is, State0} + end; + false -> + %% Make sure that the fail label is not set. + I1 = hipe_icode:call_set_fail_label(I, []), + {I1, Is, State0} + end + end. + +update_fail(I, Is, C, State, _Map) -> + case hipe_icode:fail_label(I) of + [] -> + {hipe_icode:fail_set_label(I, top_of_stack(C)), Is, State}; + _ -> + {I, Is, State} + end. + + +%%--------------------------------------------------------------------- +%% Abstraction for sets of catch stacks. + +%% This is the bottom element +no_catches() -> []. + +%% A singleton set +single_catch(C) -> [C]. + +%% A single, empty stack +empty_stack() -> []. + +%% Getting the label to fail to +top_of_stack([C|_]) -> C; +top_of_stack([]) -> []. % nil is used in Icode for "no label" + +join_catches(Cs1, Cs2) -> + ordsets:union(Cs1, Cs2). + +list_of_catches(Cs) -> Cs. + +%% Note that prepending an element to all elements in the list will +%% preserve the ordering of the list, and will never make two existing +%% elements become identical, so the list is still an ordset. + +push_catch(L, []) -> + [[L]]; +push_catch(L, Cs) -> + push_catch_1(L, Cs). + +push_catch_1(L, [C|Cs]) -> + [[L|C] | push_catch_1(L, Cs)]; +push_catch_1(_L, []) -> + []. + +%% However, after discarding the head of all elements, the list +%% is no longer an ordset, and must be processed. + +pop_catch(Cs) -> + ordsets:from_list(pop_catch_1(Cs)). + +pop_catch_1([[_|C] | Cs]) -> + [C | pop_catch_1(Cs)]; +pop_catch_1([]) -> + []. + + +%%--------------------------------------------------------------------- +%% Mapping from catch-stacks to renamings on labels. + +new_mapping() -> + gb_trees:empty(). + +set_mapping(C, L0, L1, Map) -> + Dict = case gb_trees:lookup(C, Map) of + {value, Dict0} -> + gb_trees:enter(L0, L1, Dict0); + none -> + gb_trees:insert(L0, L1, gb_trees:empty()) + end, + gb_trees:enter(C, Dict, Map). + +%% Return a label renaming function for a particular catch-stack + +get_renaming(C, Map) -> + case gb_trees:lookup(C, Map) of + {value, Dict} -> + fun (L0) -> + case gb_trees:lookup(L0, Dict) of + {value, L1} -> L1; + none -> L0 + end + end; + none -> + fun (L0) -> L0 end + end. + + +%%--------------------------------------------------------------------- +%% State abstraction + +-record(state, {cfg :: #cfg{}, + changed = false :: boolean(), + succ :: #cfg{}, + pred :: #cfg{}, + start_labels :: [icode_lbl(),...], + visited = hipe_icode_cfg:none_visited() :: gb_set(), + out = gb_trees:empty() :: gb_tree(), + in = gb_trees:empty() :: gb_tree() + }). + +init_state(CFG) -> + State = #state{cfg = CFG}, + refresh_state_cache(State). + +refresh_state_cache(State) -> + CFG = State#state.cfg, + SLs = [hipe_icode_cfg:start_label(CFG)], + State#state{succ = CFG, pred = CFG, start_labels = SLs}. + +get_cfg(State) -> + State#state.cfg. + +get_start_labels(State) -> + State#state.start_labels. + +get_pred(L, State) -> + hipe_icode_cfg:pred(State#state.pred, L). + +get_succ(L, State) -> + hipe_icode_cfg:succ(State#state.succ, L). + +set_changed(State) -> + State#state{changed = true}. + +is_changed(State) -> + State#state.changed. + +clear_changed(State) -> + State#state{changed = false}. + +set_catches_out(L, Cs, State) -> + State#state{out = gb_trees:enter(L, Cs, State#state.out)}. + +get_catches_out(L, State) -> + case gb_trees:lookup(L, State#state.out) of + {value, Cs} -> Cs; + none -> no_catches() + end. + +set_catches_in(L, Cs, State) -> + State#state{in = gb_trees:enter(L, Cs, State#state.in)}. + +get_catches_in(L, State) -> + case gb_trees:lookup(L, State#state.in) of + {value, Cs} -> Cs; + none -> no_catches() + end. + +set_visited(L, State) -> + State#state{visited = hipe_icode_cfg:visit(L, State#state.visited)}. + +is_visited(L, State) -> + hipe_icode_cfg:is_visited(L, State#state.visited). + +clear_visited(State) -> + State#state{visited = hipe_icode_cfg:none_visited()}. + +get_bb_code(L, State) -> + hipe_bb:code(hipe_icode_cfg:bb(State#state.cfg, L)). + +set_bb_code(L, Code, State) -> + CFG = State#state.cfg, + CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)), + refresh_state_cache(State#state{cfg = CFG1}). + +get_new_catches_in(L, State) -> + Ps = get_pred(L, State), + Cs = case lists:member(L, get_start_labels(State)) of + true -> single_catch(empty_stack()); + false -> no_catches() + end, + get_new_catches_in(Ps, Cs, State). + +get_new_catches_in([P | Ps], Cs, State) -> + Cs1 = join_catches(Cs, get_catches_out(P, State)), + get_new_catches_in(Ps, Cs1, State); +get_new_catches_in([], Cs, _) -> + Cs. + +%%--------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl new file mode 100644 index 0000000000..a2ca6132d1 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_fp.erl @@ -0,0 +1,1043 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-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_icode_fp.erl +%% Author : Tobias Lindahl +%% Description : One pass analysis to find floating point values. +%% Mapping to FP variables and creation of FP EBBs. +%% +%% Created : 23 Apr 2003 by Tobias Lindahl +%%-------------------------------------------------------------------- + +-module(hipe_icode_fp). + +-export([cfg/1]). + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +-record(state, {edge_map = gb_trees:empty() :: gb_tree(), + fp_ebb_map = gb_trees:empty() :: gb_tree(), + cfg :: #cfg{}}). + +%%-------------------------------------------------------------------- + +-spec cfg(#cfg{}) -> #cfg{}. + +cfg(Cfg) -> + %%hipe_icode_cfg:pp(Cfg), + NewCfg = annotate_fclearerror(Cfg), + State = new_state(NewCfg), + NewState = place_fp_blocks(State), + %% hipe_icode_cfg:pp(state__cfg(NewState)), + NewState2 = finalize(NewState), + NewCfg1 = state__cfg(NewState2), + %% hipe_icode_cfg:pp(NewCfg1), + NewCfg2 = unannotate_fclearerror(NewCfg1), + NewCfg2. + +%%-------------------------------------------------------------------- +%% Annotate fclearerror with information of the fail label of the +%% corresponding fcheckerror. +%%-------------------------------------------------------------------- + +annotate_fclearerror(Cfg) -> + Labels = hipe_icode_cfg:reverse_postorder(Cfg), + annotate_fclearerror(Labels, Cfg). + +annotate_fclearerror([Label|Left], Cfg) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(BB), + NewCode = annotate_fclearerror1(Code, Label, Cfg, []), + NewBB = hipe_bb:code_update(BB, NewCode), + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB), + annotate_fclearerror(Left, NewCfg); +annotate_fclearerror([], Cfg) -> + Cfg. + +annotate_fclearerror1([I|Left], Label, Cfg, Acc) -> + case I of + #icode_call{} -> + case hipe_icode:call_fun(I) of + fclearerror -> + Fail = lookahead_for_fcheckerror(Left, Label, Cfg), + NewI = hipe_icode:call_fun_update(I, {fclearerror, Fail}), + annotate_fclearerror1(Left, Label, Cfg, [NewI|Acc]); + _ -> + annotate_fclearerror1(Left, Label, Cfg, [I|Acc]) + end; + _ -> + annotate_fclearerror1(Left, Label, Cfg, [I|Acc]) + end; +annotate_fclearerror1([], _Label, _Cfg, Acc) -> + lists:reverse(Acc). + +lookahead_for_fcheckerror([I|Left], Label, Cfg) -> + case I of + #icode_call{} -> + case hipe_icode:call_fun(I) of + fcheckerror -> + hipe_icode:call_fail_label(I); + _ -> + lookahead_for_fcheckerror(Left, Label, Cfg) + end; + _ -> + lookahead_for_fcheckerror(Left, Label, Cfg) + end; +lookahead_for_fcheckerror([], Label, Cfg) -> + case hipe_icode_cfg:succ(Cfg, Label) of + [] -> exit("Unterminated fp ebb"); + SuccList -> + Succ = hd(SuccList), + Code = hipe_bb:code(hipe_icode_cfg:bb(Cfg, Label)), + lookahead_for_fcheckerror(Code, Succ, Cfg) + end. + +unannotate_fclearerror(Cfg) -> + Labels = hipe_icode_cfg:reverse_postorder(Cfg), + unannotate_fclearerror(Labels, Cfg). + +unannotate_fclearerror([Label|Left], Cfg) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(BB), + NewCode = unannotate_fclearerror1(Code, []), + NewBB = hipe_bb:code_update(BB, NewCode), + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB), + unannotate_fclearerror(Left, NewCfg); +unannotate_fclearerror([], Cfg) -> + Cfg. + +unannotate_fclearerror1([I|Left], Acc) -> + case I of + #icode_call{} -> + case hipe_icode:call_fun(I) of + {fclearerror, _Fail} -> + NewI = hipe_icode:call_fun_update(I, fclearerror), + unannotate_fclearerror1(Left, [NewI|Acc]); + _ -> + unannotate_fclearerror1(Left, [I|Acc]) + end; + _ -> + unannotate_fclearerror1(Left, [I|Acc]) + end; +unannotate_fclearerror1([], Acc) -> + lists:reverse(Acc). + +%%-------------------------------------------------------------------- +%% Make float EBBs +%%-------------------------------------------------------------------- + +place_fp_blocks(State) -> + WorkList = new_worklist(State), + transform_block(WorkList, State). + +transform_block(WorkList, State) -> + case get_work(WorkList) of + none -> + State; + {Label, NewWorkList} -> + %%io:format("Handling ~w \n", [Label]), + BB = state__bb(State, Label), + Code1 = hipe_bb:butlast(BB), + Last = hipe_bb:last(BB), + NofPreds = length(state__pred(State, Label)), + Map = state__map(State, Label), + FilteredMap = filter_map(Map, NofPreds), + {Prelude, NewFilteredMap} = do_prelude(FilteredMap), + + %% Take care to have a map without any new bindings from the + %% last instruction if it can fail. + {FailMap, NewCode1} = transform_instrs(Code1, Map, NewFilteredMap, []), + {NewMap, NewCode2} = transform_instrs([Last], Map, FailMap, []), + SuccSet0 = ordsets:from_list(hipe_icode:successors(Last)), + FailSet = ordsets:from_list(hipe_icode:fails_to(Last)), + SuccSet = ordsets:subtract(SuccSet0, FailSet), + NewCode = NewCode1 ++ NewCode2, + NewBB = hipe_bb:code_update(BB, Prelude++NewCode), + NewState = state__bb_add(State, Label, NewBB), + case update_maps(NewState, Label, SuccSet, NewMap, FailSet, FailMap) of + fixpoint -> + transform_block(NewWorkList, NewState); + {NewState1, AddBlocks} -> + NewWorkList1 = add_work(NewWorkList, AddBlocks), + transform_block(NewWorkList1, NewState1) + end + end. + +update_maps(State, Label, SuccSet, SuccMap, FailSet, FailMap) -> + {NewState, Add1} = update_maps(State, Label, SuccSet, SuccMap, []), + case update_maps(NewState, Label, FailSet, FailMap, Add1) of + {_NewState1, []} -> fixpoint; + {_NewState1, _Add} = Ret -> Ret + end. + +update_maps(State, From, [To|Left], Map, Acc) -> + case state__map_update(State, From, To, Map) of + fixpoint -> + update_maps(State, From, Left, Map, Acc); + NewState -> + update_maps(NewState, From, Left, Map, [To|Acc]) + end; +update_maps(State, _From, [], _Map, Acc) -> + {State, Acc}. + +transform_instrs([I|Left], PhiMap, Map, Acc) -> + Defines = hipe_icode:defines(I), + NewMap = delete_all(Defines, Map), + NewPhiMap = delete_all(Defines, PhiMap), + case I of + #icode_phi{} -> + Uses = hipe_icode:uses(I), + case [X || X <- Uses, lookup(X, PhiMap) =/= none] of + [] -> + %% No ordinary variables from the argument have been untagged. + transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]); + Uses -> + %% All arguments are untagged. Let's untag the destination. + Dst = hipe_icode:phi_dst(I), + NewDst = hipe_icode:mk_new_fvar(), + NewMap1 = gb_trees:enter(Dst, NewDst, NewMap), + NewI = subst_phi_uncond(I, NewDst, PhiMap), + transform_instrs(Left, NewPhiMap, NewMap1, [NewI|Acc]); + _ -> + %% Some arguments are untagged. Keep the destination. + Dst = hipe_icode:phi_dst(I), + NewI = subst_phi(I, Dst, PhiMap), + transform_instrs(Left, NewPhiMap, NewMap, [NewI|Acc]) + end; + #icode_call{} -> + case hipe_icode:call_fun(I) of + X when X =:= unsafe_untag_float orelse X =:= conv_to_float -> + [Dst] = hipe_icode:defines(I), + case hipe_icode:uses(I) of + [] -> %% Constant + transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]); + [Src] -> + case lookup(Src, Map) of + none -> + NewMap1 = gb_trees:enter(Src, {assigned, Dst}, NewMap), + transform_instrs(Left, NewPhiMap, NewMap1, [I|Acc]); + Dst -> + %% This is the instruction that untagged the variable. + %% Use old maps. + transform_instrs(Left, NewPhiMap, Map, [I|Acc]); + FVar -> + %% The variable was already untagged. + %% This instruction can be changed to a move. + NewI = hipe_icode:mk_move(Dst, FVar), + case hipe_icode:call_continuation(I) of + [] -> + transform_instrs(Left,NewPhiMap,NewMap,[NewI|Acc]); + ContLbl -> + Goto = hipe_icode:mk_goto(ContLbl), + transform_instrs(Left, NewPhiMap, NewMap, + [Goto, NewI|Acc]) + end + end + end; + unsafe_tag_float -> + [Dst] = hipe_icode:defines(I), + [Src] = hipe_icode:uses(I), + NewMap1 = gb_trees:enter(Dst, {assigned, Src}, NewMap), + transform_instrs(Left, NewPhiMap, NewMap1,[I|Acc]); + _ -> + {NewMap1, NewAcc} = check_for_fop_candidates(I, NewMap, Acc), + transform_instrs(Left, NewPhiMap, NewMap1, NewAcc) + end; + _ -> + NewIns = handle_untagged_arguments(I, NewMap), + transform_instrs(Left, NewPhiMap, NewMap, NewIns ++ Acc) + end; +transform_instrs([], _PhiMap, Map, Acc) -> + {Map, lists:reverse(Acc)}. + +check_for_fop_candidates(I, Map, Acc) -> + case is_fop_cand(I) of + false -> + NewIs = handle_untagged_arguments(I, Map), + {Map, NewIs ++ Acc}; + true -> + Fail = hipe_icode:call_fail_label(I), + Cont = hipe_icode:call_continuation(I), + Op = fun_to_fop(hipe_icode:call_fun(I)), + case Fail of + [] -> + Args = hipe_icode:args(I), + ConstArgs = [X || X <- Args, hipe_icode:is_const(X)], + try lists:foreach(fun(X) -> float(hipe_icode:const_value(X)) end, + ConstArgs) of + ok -> + %%io:format("Changing ~w to ~w\n", [hipe_icode:call_fun(I), Op]), + Uses = hipe_icode:uses(I), + Defines = hipe_icode:defines(I), + Convs = [X||X <- remove_duplicates(Uses), lookup(X,Map) =:= none], + NewMap0 = add_new_bindings_assigned(Convs, Map), + NewMap = add_new_bindings_unassigned(Defines, NewMap0), + ConvIns = get_conv_instrs(Convs, NewMap), + NewI = hipe_icode:mk_primop(lookup_list(Defines, NewMap), Op, + lookup_list_keep_consts(Args,NewMap), + Cont, Fail), + NewI2 = conv_consts(ConstArgs, NewI), + {NewMap, [NewI2|ConvIns]++Acc} + catch + error:badarg -> + %% This instruction will fail at runtime. The warning + %% should already have happened in hipe_icode_type. + NewIs = handle_untagged_arguments(I, Map), + {Map, NewIs ++ Acc} + end; + _ -> %% Bailing out! Can't handle instructions in catches (yet). + NewIs = handle_untagged_arguments(I, Map), + {Map, NewIs ++ Acc} + end + end. + + +%% If this is an instruction that needs to operate on tagged values, +%% which currently are untagged, we must tag the values and perhaps +%% end the fp ebb. + +handle_untagged_arguments(I, Map) -> + case [X || X <- hipe_icode:uses(I), must_be_tagged(X, Map)] of + [] -> + [I]; + Tag -> + TagIntrs = + [hipe_icode:mk_primop([Dst], unsafe_tag_float, + [gb_trees:get(Dst, Map)]) || Dst <- Tag], + [I|TagIntrs] + end. + +%% Add phi nodes for untagged fp values. + +do_prelude(Map) -> + case gb_trees:lookup(phi, Map) of + none -> + {[], Map}; + {value, List} -> + %%io:format("Adding phi: ~w\n", [List]), + Fun = fun ({FVar, Bindings}, Acc) -> + [hipe_icode:mk_phi(FVar, Bindings)|Acc] + end, + {lists:foldl(Fun, [], List), gb_trees:delete(phi, Map)} + end. + +split_code(Code) -> + split_code(Code, []). + +split_code([I], Acc) -> + {lists:reverse(Acc), I}; +split_code([I|Left], Acc) -> + split_code(Left, [I|Acc]). + + +%% When all code is mapped to fp instructions we must make sure that +%% the fp ebb information going into each block is the same as the +%% information coming out of each predecessor. Otherwise, we must add +%% a block in between. + +finalize(State) -> + Worklist = new_worklist(State), + NewState = place_error_handling(Worklist, State), + Edges = needs_fcheckerror(NewState), + finalize(Edges, NewState). + +finalize([{From, To}|Left], State) -> + NewState = add_fp_ebb_fixup(From, To, State), + finalize(Left, NewState); +finalize([], State) -> + State. + +needs_fcheckerror(State) -> + Cfg = state__cfg(State), + Labels = hipe_icode_cfg:labels(Cfg), + needs_fcheckerror(Labels, State, []). + +needs_fcheckerror([Label|Left], State, Acc) -> + case state__get_in_block_in(State, Label) of + {true, _} -> + needs_fcheckerror(Left, State, Acc); + false -> + Pred = state__pred(State, Label), + case [X || X <- Pred, state__get_in_block_out(State, X) =/= false] of + [] -> + needs_fcheckerror(Left, State, Acc); + NeedsFcheck -> + case length(Pred) =:= length(NeedsFcheck) of + true -> + %% All edges need fcheckerror. Add this to the + %% beginning of the block instead. + needs_fcheckerror(Left, State, [{none, Label}|Acc]); + false -> + Edges = [{X, Label} || X <- NeedsFcheck], + needs_fcheckerror(Left, State, Edges ++ Acc) + end + end + end; +needs_fcheckerror([], _State, Acc) -> + Acc. + +add_fp_ebb_fixup('none', To, State) -> + %% Add the fcheckerror to the start of the block. + BB = state__bb(State, To), + Code = hipe_bb:code(BB), + Phis = lists:takewhile(fun(X) -> hipe_icode:is_phi(X) end, Code), + TailCode = lists:dropwhile(fun(X) -> hipe_icode:is_phi(X) end, Code), + FC = hipe_icode:mk_primop([], fcheckerror, []), + NewCode = Phis ++ [FC|TailCode], + state__bb_add(State, To, hipe_bb:code_update(BB, NewCode)); +add_fp_ebb_fixup(From, To, State) -> + FCCode = [hipe_icode:mk_primop([], fcheckerror, [], To, [])], + FCBB = hipe_bb:mk_bb(FCCode), + FCLabel = hipe_icode:label_name(hipe_icode:mk_new_label()), + NewState = state__bb_add(State, FCLabel, FCBB), + NewState1 = state__redirect(NewState, From, To, FCLabel), + ToBB = state__bb(NewState, To), + ToCode = hipe_bb:code(ToBB), + NewToCode = redirect_phis(ToCode, From, FCLabel), + NewToBB = hipe_bb:code_update(ToBB, NewToCode), + state__bb_add(NewState1, To, NewToBB). + +redirect_phis(Code, OldFrom, NewFrom) -> + redirect_phis(Code, OldFrom, NewFrom, []). + +redirect_phis([I|Is] = Code, OldFrom, NewFrom, Acc) -> + case I of + #icode_phi{} -> + NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom), + redirect_phis(Is, OldFrom, NewFrom, [NewI|Acc]); + _ -> + lists:reverse(Acc) ++ Code + end; +redirect_phis([], _OldFrom, _NewFrom, Acc) -> + lists:reverse(Acc). + +subst_phi(I, Dst, Map) -> + ArgList = subst_phi_uses0(hipe_icode:phi_arglist(I), Map, []), + hipe_icode:mk_phi(Dst, ArgList). + +subst_phi_uses0([{Pred, Var}|Left], Map, Acc) -> + case gb_trees:lookup(Var, Map) of + {value, List} -> + case lists:keyfind(Pred, 1, List) of + {Pred, {assigned, _NewVar}} -> + %% The variable is untagged, but it has been assigned. Keep it! + subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]); + {Pred, _NewVar} = PredNV -> + %% The variable is untagged and it has never been assigned as tagged. + subst_phi_uses0(Left, Map, [PredNV | Acc]); + false -> + %% The variable is not untagged. + subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]) + end; + none -> + %% The variable is not untagged. + subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]) + end; +subst_phi_uses0([], _Map, Acc) -> + Acc. + +subst_phi_uncond(I, Dst, Map) -> + ArgList = subst_phi_uses_uncond0(hipe_icode:phi_arglist(I), Map, []), + hipe_icode:mk_phi(Dst, ArgList). + +subst_phi_uses_uncond0([{Pred, Var}|Left], Map, Acc) -> + case gb_trees:lookup(Var, Map) of + {value, List} -> + case lists:keyfind(Pred, 1, List) of + {Pred, {assigned, NewVar}} -> + %% The variable is untagged! + subst_phi_uses_uncond0(Left, Map, [{Pred, NewVar} | Acc]); + {Pred, _NewVar} = PredNV -> + %% The variable is untagged! + subst_phi_uses_uncond0(Left, Map, [PredNV | Acc]); + false -> + %% The variable is not untagged. + subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc]) + end; + none -> + %% The variable is not untagged. + subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc]) + end; +subst_phi_uses_uncond0([], _Map, Acc) -> + Acc. + +place_error_handling(WorkList, State) -> + case get_work(WorkList) of + none -> + State; + {Label, NewWorkList} -> + BB = state__bb(State, Label), + Code = hipe_bb:code(BB), + case state__join_in_block(State, Label) of + fixpoint -> + place_error_handling(NewWorkList, State); + {NewState, NewInBlock} -> + {NewCode1, InBlockOut} = place_error(Code, NewInBlock, []), + Succ = state__succ(NewState, Label), + NewCode2 = handle_unchecked_end(Succ, NewCode1, InBlockOut), + NewBB = hipe_bb:code_update(BB, NewCode2), + NewState1 = state__bb_add(NewState, Label, NewBB), + NewState2 = state__in_block_out_update(NewState1, Label, InBlockOut), + NewWorkList1 = add_work(NewWorkList, Succ), + place_error_handling(NewWorkList1, NewState2) + end + end. + +place_error([I|Left], InBlock, Acc) -> + case I of + #icode_call{} -> + case hipe_icode:call_fun(I) of + X when X =:= fp_add; X =:= fp_sub; + X =:= fp_mul; X =:= fp_div; X =:= fnegate -> + case InBlock of + false -> + Clear = hipe_icode:mk_primop([], {fclearerror, []}, []), + place_error(Left, {true, []}, [I, Clear|Acc]); + {true, _} -> + place_error(Left, InBlock, [I|Acc]) + end; + unsafe_tag_float -> + case InBlock of + {true, Fail} -> + Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail), + place_error(Left, false, [I, Check|Acc]); + false -> + place_error(Left, InBlock, [I|Acc]) + end; + {fclearerror, Fail} -> + case InBlock of + {true, Fail} -> + %% We can remove this fclearerror! + case hipe_icode:call_continuation(I) of + [] -> + place_error(Left, InBlock, Acc); + Cont -> + place_error(Left, InBlock, [hipe_icode:mk_goto(Cont)|Acc]) + end; + {true, _OtherFail} -> + %% TODO: This can be handled but it requires breaking up + %% the BB in two. Currently this should not happen. + exit("Starting fp ebb with different fail label"); + false -> + place_error(Left, {true, Fail}, [I|Acc]) + end; + fcheckerror -> + case {true, hipe_icode:call_fail_label(I)} of + InBlock -> + %% No problem + place_error(Left, false, [I|Acc]); + NewInblock -> + exit({"Fcheckerror has the wrong fail label", + InBlock, NewInblock}) + end; + X when X =:= conv_to_float; X =:= unsafe_untag_float -> + place_error(Left, InBlock, [I|Acc]); + _Other -> + case hipe_icode_primops:fails(hipe_icode:call_fun(I)) of + false -> + place_error(Left, InBlock, [I|Acc]); + true -> + case InBlock of + {true, Fail} -> + Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail), + place_error(Left, false, [I, Check|Acc]); + false -> + place_error(Left, InBlock, [I|Acc]) + end + end + end; + #icode_fail{} -> + place_error_1(I, Left, InBlock, Acc); + #icode_return{} -> + place_error_1(I, Left, InBlock, Acc); + #icode_enter{} -> + place_error_1(I, Left, InBlock, Acc); + Other -> + case instr_allowed_in_fp_ebb(Other) of + true -> + place_error(Left, InBlock, [I|Acc]); + false -> + case InBlock of + {true, []} -> + Check = hipe_icode:mk_primop([], fcheckerror, []), + place_error(Left, false, [I, Check|Acc]); + {true, _} -> + exit({"Illegal instruction in caught fp ebb", I}); + false -> + place_error(Left, InBlock, [I|Acc]) + end + end + end; +place_error([], InBlock, Acc) -> + {lists:reverse(Acc), InBlock}. + +place_error_1(I, Left, InBlock, Acc) -> + case InBlock of + {true, []} -> + Check = hipe_icode:mk_primop([], fcheckerror, []), + place_error(Left, false, [I, Check|Acc]); + {true, _} -> + exit({"End of control flow in caught fp ebb", I}); + false -> + place_error(Left, InBlock, [I|Acc]) + end. + +%% If the block has no successors and we still are in a fp ebb we must +%% end it to make sure we don't have any unchecked fp exceptions. + +handle_unchecked_end(Succ, Code, InBlock) -> + case Succ of + [] -> + case InBlock of + {true, []} -> + {TopCode, Last} = split_code(Code), + NewI = hipe_icode:mk_primop([], fcheckerror, []), + TopCode ++ [NewI, Last]; + false -> + Code + end; + _ -> + Code + end. + +instr_allowed_in_fp_ebb(Instr) -> + case Instr of + #icode_comment{} -> true; + #icode_goto{} -> true; + #icode_if{} -> true; + #icode_move{} -> true; + #icode_phi{} -> true; + #icode_begin_handler{} -> true; + #icode_switch_tuple_arity{} -> true; + #icode_switch_val{} -> true; + #icode_type{} -> true; + _ -> false + end. + +%%============================================================= +%% Help functions +%%============================================================= + +%% ------------------------------------------------------------ +%% Handling the gb_tree + +delete_all([Key|Left], Tree) -> + delete_all(Left, gb_trees:delete_any(Key, Tree)); +delete_all([], Tree) -> + Tree. + +lookup_list(List, Info) -> + lookup_list(List, fun lookup/2, Info, []). + +lookup_list([H|T], Fun, Info, Acc) -> + lookup_list(T, Fun, Info, [Fun(H, Info)|Acc]); +lookup_list([], _, _, Acc) -> + lists:reverse(Acc). + +lookup(Key, Tree) -> + case hipe_icode:is_const(Key) of + %% This can be true if the same constant has been + %% untagged more than once + true -> none; + false -> + case gb_trees:lookup(Key, Tree) of + none -> none; + {value, {assigned, Val}} -> Val; + {value, Val} -> Val + end + end. + +lookup_list_keep_consts(List, Info) -> + lookup_list(List, fun lookup_keep_consts/2, Info, []). + +lookup_keep_consts(Key, Tree) -> + case hipe_icode:is_const(Key) of + true -> Key; + false -> + case gb_trees:lookup(Key, Tree) of + none -> none; + {value, {assigned, Val}} -> Val; + {value, Val} -> Val + end + end. + +get_type(Var) -> + case hipe_icode:is_const(Var) of + true -> erl_types:t_from_term(hipe_icode:const_value(Var)); + false -> + case hipe_icode:is_annotated_variable(Var) of + true -> + {type_anno, Type, _} = hipe_icode:variable_annotation(Var), + Type +%%% false -> erl_types:t_any() + end + end. + +%% ------------------------------------------------------------ +%% Handling the map from variables to fp-variables + +join_maps(Edges, EdgeMap) -> + join_maps(Edges, EdgeMap, gb_trees:empty()). + +join_maps([Edge = {Pred, _}|Left], EdgeMap, Map) -> + case gb_trees:lookup(Edge, EdgeMap) of + none -> + %% All predecessors have not been handled. Use empty map. + gb_trees:empty(); + {value, OldMap} -> + NewMap = join_maps0(gb_trees:to_list(OldMap), Pred, Map), + join_maps(Left, EdgeMap, NewMap) + end; +join_maps([], _, Map) -> + Map. + +join_maps0([{phi, _}|Tail], Pred, Map) -> + join_maps0(Tail, Pred, Map); +join_maps0([{Var, FVar}|Tail], Pred, Map) -> + case gb_trees:lookup(Var, Map) of + none -> + join_maps0(Tail, Pred, gb_trees:enter(Var, [{Pred, FVar}], Map)); + {value, List} -> + case lists:keyfind(Pred, 1, List) of + false -> + join_maps0(Tail, Pred, gb_trees:update(Var, [{Pred, FVar}|List], Map)); + {Pred, FVar} -> + %% No problem. + join_maps0(Tail, Pred, Map); + _ -> + exit('New binding to same variable') + end + end; +join_maps0([], _, Map) -> + Map. + +filter_map(Map, NofPreds) -> + filter_map(gb_trees:to_list(Map), NofPreds, Map). + +filter_map([{Var, Bindings}|Left], NofPreds, Map) -> + case length(Bindings) =:= NofPreds of + true -> + case all_args_equal(Bindings) of + true -> + {_, FVar} = hd(Bindings), + filter_map(Left, NofPreds, gb_trees:update(Var, FVar, Map)); + false -> + PhiDst = hipe_icode:mk_new_fvar(), + PhiArgs = strip_of_assigned(Bindings), + NewMap = + case gb_trees:lookup(phi, Map) of + none -> + gb_trees:insert(phi, [{PhiDst, PhiArgs}], Map); + {value, Val} -> + gb_trees:update(phi, [{PhiDst, PhiArgs}|Val], Map) + end, + NewBinding = + case bindings_are_assigned(Bindings) of + true -> {assigned, PhiDst}; + false -> PhiDst + end, + filter_map(Left, NofPreds, gb_trees:update(Var, NewBinding, NewMap)) + end; + false -> + filter_map(Left, NofPreds, gb_trees:delete(Var, Map)) + end; +filter_map([], _NofPreds, Map) -> + Map. + +bindings_are_assigned([{_, {assigned, _}}|Left]) -> + assert_assigned(Left), + true; +bindings_are_assigned(Bindings) -> + assert_not_assigned(Bindings), + false. + +assert_assigned([{_, {assigned, _}}|Left]) -> + assert_assigned(Left); +assert_assigned([]) -> + ok. + +assert_not_assigned([{_, FVar}|Left]) -> + true = hipe_icode:is_fvar(FVar), + assert_not_assigned(Left); +assert_not_assigned([]) -> + ok. + +%% all_args_equal returns true if the mapping for a variable is the +%% same from all predecessors, i.e., we do not need a phi-node. + +all_args_equal([{_, FVar}|Left]) -> + all_args_equal(Left, FVar). + +all_args_equal([{_, FVar1}|Left], FVar1) -> + all_args_equal(Left, FVar1); +all_args_equal([], _) -> + true; +all_args_equal(_, _) -> + false. + + +%% We differentiate between values that have been assigned as +%% tagged variables and those that got a 'virtual' binding. + +add_new_bindings_unassigned([Var|Left], Map) -> + FVar = hipe_icode:mk_new_fvar(), + add_new_bindings_unassigned(Left, gb_trees:insert(Var, FVar, Map)); +add_new_bindings_unassigned([], Map) -> + Map. + +add_new_bindings_assigned([Var|Left], Map) -> + case lookup(Var, Map) of + none -> + FVar = hipe_icode:mk_new_fvar(), + NewMap = gb_trees:insert(Var, {assigned, FVar}, Map), + add_new_bindings_assigned(Left, NewMap); + _ -> + add_new_bindings_assigned(Left, Map) + end; +add_new_bindings_assigned([], Map) -> + Map. + +strip_of_assigned(List) -> + strip_of_assigned(List, []). + +strip_of_assigned([{Pred, {assigned, Val}}|Left], Acc) -> + strip_of_assigned(Left, [{Pred, Val}|Acc]); +strip_of_assigned([Tuple|Left], Acc) -> + strip_of_assigned(Left, [Tuple|Acc]); +strip_of_assigned([], Acc) -> + Acc. + +%% ------------------------------------------------------------ +%% Help functions for the transformation from ordinary instruction to +%% fp-instruction + +is_fop_cand(I) -> + case hipe_icode:call_fun(I) of + '/' -> true; + Fun -> + case fun_to_fop(Fun) of + false -> false; + _ -> any_is_float(hipe_icode:args(I)) + end + end. + +any_is_float(Vars) -> + lists:any(fun (V) -> erl_types:t_is_float(get_type(V)) end, Vars). + +remove_duplicates(List) -> + remove_duplicates(List, []). + +remove_duplicates([X|Left], Acc) -> + case lists:member(X, Acc) of + true -> + remove_duplicates(Left, Acc); + false -> + remove_duplicates(Left, [X|Acc]) + end; +remove_duplicates([], Acc) -> + Acc. + +fun_to_fop(Fun) -> + case Fun of + '+' -> fp_add; + '-' -> fp_sub; + '*' -> fp_mul; + '/' -> fp_div; + _ -> false + end. + + +%% If there is a tagged version of this variable available we don't +%% have to tag the untagged version. + +must_be_tagged(Var, Map) -> + case gb_trees:lookup(Var, Map) of + none -> false; + {value, {assigned, _}} -> false; + {value, Val} -> hipe_icode:is_fvar(Val) + end. + + +%% Converting to floating point variables + +get_conv_instrs(Vars, Map) -> + get_conv_instrs(Vars, Map, []). + +get_conv_instrs([Var|Left], Map, Acc) -> + {_, Dst} = gb_trees:get(Var, Map), + NewI = + case erl_types:t_is_float(get_type(Var)) of + true -> + [hipe_icode:mk_primop([Dst], unsafe_untag_float, [Var])]; + false -> + [hipe_icode:mk_primop([Dst], conv_to_float, [Var])] + end, + get_conv_instrs(Left, Map, NewI++Acc); +get_conv_instrs([], _, Acc) -> + Acc. + + +conv_consts(ConstArgs, I) -> + conv_consts(ConstArgs, I, []). + +conv_consts([Const|Left], I, Subst) -> + NewConst = hipe_icode:mk_const(float(hipe_icode:const_value(Const))), + conv_consts(Left, I, [{Const, NewConst}|Subst]); +conv_consts([], I, Subst) -> + hipe_icode:subst_uses(Subst, I). + + +%% _________________________________________________________________ +%% +%% Handling the state +%% + +new_state(Cfg) -> + #state{cfg = Cfg}. + +state__cfg(#state{cfg = Cfg}) -> + Cfg. + +state__succ(#state{cfg = Cfg}, Label) -> + hipe_icode_cfg:succ(Cfg, Label). + +state__pred(#state{cfg = Cfg}, Label) -> + hipe_icode_cfg:pred(Cfg, Label). + +state__redirect(S = #state{cfg = Cfg}, From, ToOld, ToNew) -> + NewCfg = hipe_icode_cfg:redirect(Cfg, From, ToOld, ToNew), + S#state{cfg=NewCfg}. + +state__bb(#state{cfg = Cfg}, Label) -> + hipe_icode_cfg:bb(Cfg, Label). + +state__bb_add(S = #state{cfg = Cfg}, Label, BB) -> + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), + S#state{cfg = NewCfg}. + +state__map(S = #state{edge_map = EM}, To) -> + join_maps([{From, To} || From <- state__pred(S, To)], EM). + +state__map_update(S = #state{edge_map = EM}, From, To, Map) -> + FromTo = {From, To}, + MapChanged = + case gb_trees:lookup(FromTo, EM) of + {value, Map1} -> not match(Map1, Map); + none -> true + end, + case MapChanged of + true -> + NewEM = gb_trees:enter(FromTo, Map, EM), + S#state{edge_map = NewEM}; + false -> + fixpoint + end. + +state__join_in_block(S = #state{fp_ebb_map = Map}, Label) -> + Pred = state__pred(S, Label), + Edges = [{X, Label} || X <- Pred], + NewInBlock = join_in_block([gb_trees:lookup(X, Map) || X <- Edges]), + InBlockLabel = {inblock_in, Label}, + case gb_trees:lookup(InBlockLabel, Map) of + none -> + NewMap = gb_trees:insert(InBlockLabel, NewInBlock, Map), + {S#state{fp_ebb_map = NewMap}, NewInBlock}; + {value, NewInBlock} -> + fixpoint; + _Other -> + NewMap = gb_trees:update(InBlockLabel, NewInBlock, Map), + {S#state{fp_ebb_map = NewMap}, NewInBlock} + end. + +state__in_block_out_update(S = #state{fp_ebb_map = Map}, Label, NewInBlock) -> + Succ = state__succ(S, Label), + Edges = [{Label, X} || X <- Succ], + NewMap = update_edges(Edges, NewInBlock, Map), + NewMap1 = gb_trees:enter({inblock_out, Label}, NewInBlock, NewMap), + S#state{fp_ebb_map = NewMap1}. + +update_edges([Edge|Left], NewInBlock, Map) -> + NewMap = gb_trees:enter(Edge, NewInBlock, Map), + update_edges(Left, NewInBlock, NewMap); +update_edges([], _NewInBlock, NewMap) -> + NewMap. + +join_in_block([]) -> + false; +join_in_block([none|_]) -> + false; +join_in_block([{value, InBlock}|Left]) -> + join_in_block(Left, InBlock). + +join_in_block([none|_], _Current) -> + false; +join_in_block([{value, InBlock}|Left], Current) -> + if Current =:= InBlock -> join_in_block(Left, Current); + Current =:= false -> false; + InBlock =:= false -> false; + true -> exit("Basic block is in two different fp ebb:s") + end; +join_in_block([], Current) -> + Current. + + +state__get_in_block_in(#state{fp_ebb_map = Map}, Label) -> + gb_trees:get({inblock_in, Label}, Map). + +state__get_in_block_out(#state{fp_ebb_map = Map}, Label) -> + gb_trees:get({inblock_out, Label}, Map). + + +new_worklist(#state{cfg = Cfg}) -> + Start = hipe_icode_cfg:start_label(Cfg), + {[Start], [], gb_sets:insert(Start, gb_sets:empty())}. + +get_work({[Label|Left], List, Set}) -> + {Label, {Left, List, gb_sets:delete(Label, Set)}}; +get_work({[], [], _Set}) -> + none; +get_work({[], List, Set}) -> + get_work({lists:reverse(List), [], Set}). + +add_work({List1, List2, Set} = Work, [Label|Left]) -> + case gb_sets:is_member(Label, Set) of + true -> + add_work(Work, Left); + false -> + %% io:format("Added work: ~w\n", [Label]), + NewSet = gb_sets:insert(Label, Set), + add_work({List1, [Label|List2], NewSet}, Left) + end; +add_work(WorkList, []) -> + WorkList. + +match(Tree1, Tree2) -> + match_1(gb_trees:to_list(Tree1), Tree2) andalso + match_1(gb_trees:to_list(Tree2), Tree1). + +match_1([{Key, Val}|Left], Tree2) -> + case gb_trees:lookup(Key, Tree2) of + {value, Val} -> + match_1(Left, Tree2); + _ -> false + end; +match_1([], _) -> + true. diff --git a/lib/hipe/icode/hipe_icode_heap_test.erl b/lib/hipe/icode/hipe_icode_heap_test.erl new file mode 100644 index 0000000000..92d5f023fa --- /dev/null +++ b/lib/hipe/icode/hipe_icode_heap_test.erl @@ -0,0 +1,200 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Copyright (c) 2000 by Erik Johansson. All Rights Reserved +%% ==================================================================== +%% Filename : hipe_icode_heap_test.erl +%% Module : hipe_icode_heap_test +%% Purpose : +%% Notes : +%% History : * 2000-11-07 Erik Johansson (happi@it.uu.se): +%% Created. +%% +%% $Id$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hipe_icode_heap_test). + +-export([cfg/1]). + +-define(DO_ASSERT,true). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). +-include("../flow/cfg.hrl"). +-include("../rtl/hipe_literals.hrl"). + +%------------------------------------------------------------------------- + +-spec cfg(#cfg{}) -> #cfg{}. + +cfg(CFG) -> + Icode = hipe_icode_cfg:cfg_to_linear(CFG), + Code = hipe_icode:icode_code(Icode), + ActualVmax = hipe_icode:highest_var(Code), + ActualLmax = hipe_icode:highest_label(Code), + hipe_gensym:set_label(icode, ActualLmax+1), + hipe_gensym:set_var(icode, ActualVmax+1), + EBBs = hipe_icode_ebb:cfg(CFG), + {EBBcode,_Visited} = ebbs(EBBs, [], CFG), + NewCode = add_gc_tests(EBBcode), + NewIcode = hipe_icode:icode_code_update(Icode, NewCode), + NewCFG = hipe_icode_cfg:linear_to_cfg(NewIcode), + %% hipe_icode_cfg:pp(NewCFG), + NewCFG. + +ebbs([EBB|EBBs], Visited, CFG) -> + case hipe_icode_ebb:type(EBB) of + node -> + L = hipe_icode_ebb:node_label(EBB), + case visited(L, Visited) of + true -> + ebbs(EBBs, Visited, CFG); + false -> + EBBCode = hipe_bb:code(hipe_icode_cfg:bb(CFG, L)), + case hipe_icode_ebb:node_successors(EBB) of + [Succ|Succs] -> + {[SuccCode|More], Visited1} = + ebbs([Succ], [L|Visited], CFG), + {[OtherCode|MoreOther], Visited2} = + ebbs(Succs ++ EBBs, Visited1, CFG), + {[[hipe_icode:mk_label(L)|EBBCode] ++ SuccCode| + More] ++ [OtherCode|MoreOther], + Visited2}; + [] -> + {OtherCode, Visited1} = ebbs(EBBs, [L|Visited], CFG), + {[[hipe_icode:mk_label(L)|EBBCode] | OtherCode], Visited1} + end + end; + leaf -> + ebbs(EBBs, Visited, CFG) + end; +ebbs([], Visited,_) -> + {[[]], Visited}. + +visited(L, Visited) -> + lists:member(L, Visited). + +add_gc_tests([[]|EBBCodes]) -> add_gc_tests(EBBCodes); +add_gc_tests([EBBCode|EBBCodes]) -> + case need(EBBCode, 0, []) of + {Need, RestCode, [Lbl|Code]} -> + if Need > 0 -> + [Lbl] ++ gc_test(Need) ++ Code ++ add_gc_tests([RestCode|EBBCodes]); + true -> + [Lbl|Code] ++ add_gc_tests([RestCode|EBBCodes]) + end; + {0, RestCode, []} -> + add_gc_tests([RestCode|EBBCodes]) + end; +add_gc_tests([]) -> []. + +need([I|Is] , Need, Code) -> + case split(I) of + true -> + case I of + #icode_call{} -> + case hipe_icode:call_continuation(I) of + [] -> %% Was fallthrough. + NewLab = hipe_icode:mk_new_label(), + LabName = hipe_icode:label_name(NewLab), + NewCall = hipe_icode:call_set_continuation(I,LabName), + {Need + need(I), [NewLab|Is], lists:reverse([NewCall|Code])}; + _ -> + {Need + need(I), Is, lists:reverse([I|Code])} + end; + _ -> + {Need + need(I), Is, lists:reverse([I|Code])} + end; + false -> + need(Is, Need + need(I), [I|Code]) + end; +need([], Need, Code) -> + {Need, [], lists:reverse(Code)}. + +need(I) -> + case I of + #icode_call{} -> + primop_need(hipe_icode:call_fun(I), hipe_icode:call_args(I)); + #icode_enter{} -> + primop_need(hipe_icode:enter_fun(I), hipe_icode:enter_args(I)); + _ -> + 0 + end. + +primop_need(Op, As) -> + case Op of + cons -> + 2; + mktuple -> + length(As) + 1; + #mkfun{} -> + NumFree = length(As), + ?ERL_FUN_SIZE + NumFree; + unsafe_tag_float -> + 3; + _ -> + 0 + end. + +gc_test(Need) -> + L = hipe_icode:mk_new_label(), + [hipe_icode:mk_primop([], #gc_test{need=Need}, [], + hipe_icode:label_name(L), + hipe_icode:label_name(L)), + L]. + +split(I) -> + case I of + #icode_call{} -> not known_heap_need(hipe_icode:call_fun(I)); + #icode_enter{} -> not known_heap_need(hipe_icode:enter_fun(I)); + _ -> false + end. + +known_heap_need(Name) -> + case Name of + %% Primops + cons -> true; + fcheckerror -> true; + fclearerror -> true; + fnegate -> true; + fp_add -> true; + fp_div -> true; + fp_mul -> true; + fp_sub -> true; + mktuple -> true; + unsafe_hd -> true; + unsafe_tag_float -> true; + unsafe_tl -> true; + unsafe_untag_float -> true; + #element{} -> true; + #unsafe_element{} -> true; + #unsafe_update_element{} -> true; + + %% MFAs + {erlang, element, 2} -> true; + {erlang, length, 1} -> true; + {erlang, self, 0} -> true; + {erlang, size, 1} -> true; + + _ -> false + end. diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl new file mode 100644 index 0000000000..27296dcad5 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl @@ -0,0 +1,240 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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_icode_inline_bifs.erl +%% Author : Per Gustafsson +%% Purpose : Inlines BIFs which can be expressed easily in ICode. +%% This allows for optimizations in later ICode passes +%% and makes the code faster. +%% +%% Created : 14 May 2007 by Per Gustafsson +%%-------------------------------------------------------------------- + +%% Currently inlined BIFs: +%% and, or, xor, not, <, >, >=, =<, ==, /=, =/=, =:= +%% is_atom, is_boolean, is_binary, is_constant, is_float, is_function, +%% is_integer, is_list, is_pid, is_port, is_reference, is_tuple + +-module(hipe_icode_inline_bifs). + +-export([cfg/1]). + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +%%-------------------------------------------------------------------- + +-spec cfg(#cfg{}) -> #cfg{}. + +cfg(Cfg) -> + Linear = hipe_icode_cfg:cfg_to_linear(Cfg), + #icode{code = StraightCode} = Linear, + FinalCode = lists:flatten([inline_bif(I) || I <- StraightCode]), + Cfg1 = hipe_icode_cfg:linear_to_cfg(Linear#icode{code = FinalCode}), + hipe_icode_cfg:remove_unreachable_code(Cfg1). + +inline_bif(I = #icode_call{}) -> + try_conditional(I); +inline_bif(I) -> + I. + +try_conditional(I = #icode_call{dstlist = [Dst], 'fun' = {erlang, Name, 2}, + args = [Arg1, Arg2], + continuation = Cont}) -> + case is_conditional(Name) of + true -> + inline_conditional(Dst, Name, Arg1, Arg2, Cont); + false -> + try_bool(I) + end; +try_conditional(I) -> + try_bool(I). + +is_conditional(Name) -> + case Name of + '=:=' -> true; + '=/=' -> true; + '==' -> true; + '/=' -> true; + '>' -> true; + '<' -> true; + '>=' -> true; + '=<' -> true; + _ -> false + end. + +try_bool(I = #icode_call{dstlist = [Dst], 'fun' = Name, + args = [Arg1, Arg2], + continuation = Cont, fail_label = Fail}) -> + case is_binary_bool(Name) of + {true, Results, ResLbls} -> + inline_binary_bool(Dst, Results, ResLbls, Arg1, Arg2, Cont, Fail, I); + false -> + try_type_tests(I) + end; +try_bool(I = #icode_call{dstlist = [Dst], 'fun' = {erlang, 'not', 1}, + args = [Arg1], + continuation = Cont, + fail_label = Fail}) -> + inline_unary_bool(Dst, {false, true}, Arg1, Cont, Fail, I); +try_bool(I) -> try_type_tests(I). + +is_binary_bool({erlang, Name, 2}) -> + ResTLbl = hipe_icode:mk_new_label(), + ResFLbl = hipe_icode:mk_new_label(), + ResTL = hipe_icode:label_name(ResTLbl), + ResFL = hipe_icode:label_name(ResFLbl), + case Name of + 'and' -> {true, {ResTL, ResFL, ResFL}, {ResTLbl, ResFLbl}}; + 'or' -> {true, {ResTL, ResTL, ResFL}, {ResTLbl, ResFLbl}}; + 'xor' -> {true, {ResFL, ResTL, ResFL}, {ResTLbl, ResFLbl}}; + _ -> false + end; +is_binary_bool(_) -> false. + +try_type_tests(I = #icode_call{dstlist=[Dst], 'fun' = {erlang, Name, 1}, + args = Args, continuation = Cont}) -> + case is_type_test(Name) of + {true, Type} -> + inline_type_test(Dst, Type, Args, Cont); + false -> + I + end; +try_type_tests(I) -> I. + +is_type_test(Name) -> + case Name of + is_integer -> {true, integer}; + is_float -> {true, float}; + is_tuple -> {true, tuple}; + is_binary -> {true, binary}; + is_list -> {true, list}; + is_pid -> {true, pid}; + is_atom -> {true, atom}; + is_boolean -> {true, boolean}; + is_function -> {true, function}; + is_reference -> {true, reference}; + is_constant -> {true, constant}; + is_port -> {true, port}; + _ -> false + end. + +inline_type_test(BifRes, Type, Src, Cont) -> + {NewCont, NewEnd} = get_cont_lbl(Cont), + TLbl = hipe_icode:mk_new_label(), + FLbl = hipe_icode:mk_new_label(), + TL = hipe_icode:label_name(TLbl), + FL = hipe_icode:label_name(FLbl), + [hipe_icode:mk_type(Src, Type, TL, FL), + TLbl, + hipe_icode:mk_move(BifRes, hipe_icode:mk_const(true)), + hipe_icode:mk_goto(NewCont), + FLbl, + hipe_icode:mk_move(BifRes, hipe_icode:mk_const(false)), + hipe_icode:mk_goto(NewCont)| + NewEnd]. + +inline_conditional(BifRes, Op, Src1, Src2, Cont) -> + {NewCont, NewEnd} = get_cont_lbl(Cont), + TLbl = hipe_icode:mk_new_label(), + FLbl = hipe_icode:mk_new_label(), + TL = hipe_icode:label_name(TLbl), + FL = hipe_icode:label_name(FLbl), + [hipe_icode:mk_if(Op, [Src1, Src2], TL, FL), + TLbl, + hipe_icode:mk_move(BifRes, hipe_icode:mk_const(true)), + hipe_icode:mk_goto(NewCont), + FLbl, + hipe_icode:mk_move(BifRes, hipe_icode:mk_const(false)), + hipe_icode:mk_goto(NewCont)| + NewEnd]. + +%% +%% The TTL TFL FFL labelnames points to either ResTLbl or ResFLbl +%% Depending on what boolean expression we are inlining +%% + +inline_binary_bool(Dst, {TTL, TFL, FFL}, {ResTLbl, ResFLbl}, + Arg1, Arg2, Cont, Fail, I) -> + {NewCont, NewEnd} = get_cont_lbl(Cont), + {NewFail, FailCode} = get_fail_lbl(Fail, I), + EndCode = FailCode++NewEnd, + TLbl = hipe_icode:mk_new_label(), + FLbl = hipe_icode:mk_new_label(), + NotTLbl = hipe_icode:mk_new_label(), + NotTTLbl = hipe_icode:mk_new_label(), + NotTFLbl = hipe_icode:mk_new_label(), + TL = hipe_icode:label_name(TLbl), + FL = hipe_icode:label_name(FLbl), + NotTL = hipe_icode:label_name(NotTLbl), + NotTTL = hipe_icode:label_name(NotTTLbl), + NotTFL = hipe_icode:label_name(NotTFLbl), + [hipe_icode:mk_type([Arg1], {atom, true}, TL, NotTL, 0.5), + NotTLbl, + hipe_icode:mk_type([Arg1], {atom, false}, FL, NewFail, 0.99), + TLbl, + hipe_icode:mk_type([Arg2], {atom, true}, TTL, NotTTL, 0.5), + NotTTLbl, + hipe_icode:mk_type([Arg2], {atom, false}, TFL, NewFail, 0.99), + FLbl, + hipe_icode:mk_type([Arg2], {atom, true}, TFL, NotTFL, 0.5), + NotTFLbl, + hipe_icode:mk_type([Arg2], {atom, false}, FFL, NewFail, 0.99), + ResTLbl, + hipe_icode:mk_move(Dst, hipe_icode:mk_const(true)), + hipe_icode:mk_goto(NewCont), + ResFLbl, + hipe_icode:mk_move(Dst, hipe_icode:mk_const(false)), + hipe_icode:mk_goto(NewCont)| + EndCode]. + +inline_unary_bool(Dst, {T,F}, Arg1, Cont, Fail, I) -> + TLbl = hipe_icode:mk_new_label(), + NotTLbl = hipe_icode:mk_new_label(), + FLbl = hipe_icode:mk_new_label(), + TL = hipe_icode:label_name(TLbl), + NotTL = hipe_icode:label_name(NotTLbl), + FL = hipe_icode:label_name(FLbl), + {NewCont, NewEnd} = get_cont_lbl(Cont), + {NewFail, FailCode} = get_fail_lbl(Fail, I), + EndCode = FailCode ++ NewEnd, + Arg1L = [Arg1], + [hipe_icode:mk_type(Arg1L, {atom, true}, TL, NotTL, 0.5), + NotTLbl, + hipe_icode:mk_type(Arg1L, {atom, false}, FL, NewFail, 0.99), + TLbl, + hipe_icode:mk_move(Dst, hipe_icode:mk_const(T)), + hipe_icode:mk_goto(NewCont), + FLbl, + hipe_icode:mk_move(Dst, hipe_icode:mk_const(F)), + hipe_icode:mk_goto(NewCont)| + EndCode]. + +get_cont_lbl([]) -> + NL = hipe_icode:mk_new_label(), + {hipe_icode:label_name(NL), [NL]}; +get_cont_lbl(Cont) -> + {Cont, []}. + +get_fail_lbl([], I) -> + NL = hipe_icode:mk_new_label(), + {hipe_icode:label_name(NL), [NL, I]}; +get_fail_lbl(Fail, _) -> + {Fail, []}. diff --git a/lib/hipe/icode/hipe_icode_instruction_counter.erl b/lib/hipe/icode/hipe_icode_instruction_counter.erl new file mode 100644 index 0000000000..92658d294a --- /dev/null +++ b/lib/hipe/icode/hipe_icode_instruction_counter.erl @@ -0,0 +1,135 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-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 : icode_instruction_counter.erl +%% Author : Andreas Hasselberg +%% Purpose : This module counts the number of different instructions +%% in a function. It is useful when you want to know if +%% your Icode analysis or specialization is good, bad or +%% simply unlucky :) +%% +%% Created : 2 Oct 2006 by Andreas Hasselberg +%%------------------------------------------------------------------- + +-module(hipe_icode_instruction_counter). + +-export([cfg/3, compare/3]). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +%%------------------------------------------------------------------- +%% A general CFG instruction walktrough +%%------------------------------------------------------------------- + +-spec cfg(#cfg{}, mfa(), comp_options()) -> [_]. + +cfg(Cfg, _IcodeFun, _Options) -> + Labels = hipe_icode_cfg:labels(Cfg), + %% Your Info init function goes here + InitInfo = counter__init_info(), + Info = lists:foldl(fun (Label, InfoAcc) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(BB), + walktrough_bb(Code, InfoAcc) + end, InitInfo, Labels), + %% counter__output_info(IcodeFun, Info), + Info. + +walktrough_bb(BB, Info) -> + lists:foldl(fun (Insn, InfoAcc) -> + %% Your analysis function here + counter__analys_insn(Insn, InfoAcc) + end, Info, BB). + +%%------------------------------------------------------------------- +%% The counter specific functions +%%------------------------------------------------------------------- + +-spec compare(gb_tree(), gb_tree(), gb_tree()) -> gb_tree(). + +compare(Name, Old, New) -> + NewList = gb_trees:to_list(New), + OldList = gb_trees:to_list(Old), + TempTree = compare_one_way(NewList, Old, added, gb_trees:empty()), + DiffTree = compare_one_way(OldList, New, removed, TempTree), + DiffList = gb_trees:to_list(DiffTree), + if DiffList =:= [] -> + ok; + true -> + io:format("~p: ~p ~n", [Name, DiffList]) + end, + DiffTree. + +compare_one_way(List, Tree, Key, Fold_tree) -> + lists:foldl(fun({Insn, ListCount}, DiffAcc) when is_integer(ListCount) -> + DiffCount = + case gb_trees:lookup(Insn, Tree) of + {value, TreeCount} when is_integer(TreeCount) -> + ListCount - TreeCount; + none -> + ListCount + end, + if DiffCount > 0 -> + gb_trees:insert({Key, Insn}, DiffCount, DiffAcc); + true -> + DiffAcc + end + end, + Fold_tree, + List). + +counter__init_info() -> + gb_trees:empty(). + +counter__analys_insn(Insn, Info) -> + Key = counter__insn_get_key(Insn), + counter__increase_key(Key, Info). + +counter__insn_get_key(If = #icode_if{}) -> {'if', hipe_icode:if_op(If)}; +counter__insn_get_key(Call = #icode_call{}) -> {call, hipe_icode:call_fun(Call)}; +counter__insn_get_key(#icode_enter{}) -> enter; +counter__insn_get_key(#icode_return{}) -> return; +counter__insn_get_key(#icode_type{}) -> type; +counter__insn_get_key(#icode_switch_val{}) -> switch_val; +counter__insn_get_key(#icode_switch_tuple_arity{}) -> switch_tuple_arity; +counter__insn_get_key(#icode_goto{}) -> goto; +counter__insn_get_key(#icode_move{}) -> move; +counter__insn_get_key(#icode_phi{}) -> phi; +counter__insn_get_key(#icode_begin_try{}) -> begin_try; +counter__insn_get_key(#icode_end_try{}) -> end_try; +counter__insn_get_key(#icode_begin_handler{}) -> begin_handler; +counter__insn_get_key(#icode_fail{}) -> fail; +counter__insn_get_key(#icode_comment{}) -> comment. + +counter__increase_key(Key, Info) -> + NewCounter = + case gb_trees:lookup(Key, Info) of + {value, Counter} when is_integer(Counter) -> + Counter + 1; + none -> + 1 + end, + gb_trees:enter(Key, NewCounter, Info). + +%%counter__output_info(IcodeFun, Info) -> +%% InfoList = gb_trees:to_list(Info), +%% io:format("~p instructions : ~p ~n", [IcodeFun, InfoList]). diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl new file mode 100644 index 0000000000..5816e59032 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_liveness.erl @@ -0,0 +1,101 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% ICODE LIVENESS ANALYSIS +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hipe_icode_liveness). + +-define(PRETTY_PRINT, true). + +-include("hipe_icode.hrl"). +-include("../flow/liveness.inc"). + +%%-------------------------------------------------------------------- +%% Interface to CFG and icode. +%%-------------------------------------------------------------------- + +cfg_bb(CFG, L) -> + hipe_icode_cfg:bb(CFG, L). + +cfg_postorder(CFG) -> + hipe_icode_cfg:postorder(CFG). + +cfg_succ(CFG, L) -> + hipe_icode_cfg:succ(CFG, L). + +uses(Instr) -> + hipe_icode:uses(Instr). + +defines(Instr) -> + hipe_icode:defines(Instr). + +%% +%% This is the list of registers that are live at exit from a function +%% +cfg_labels(CFG) -> + hipe_icode_cfg:labels(CFG). + +liveout_no_succ() -> + ordsets:new(). + +pp_liveness_info(LiveList) -> + print_live_list(LiveList). + +print_live_list([]) -> + io:format(" none~n", []); +print_live_list([Last]) -> + io:format(" ", []), + print_var(Last), + io:format("~n", []); +print_live_list([Var|Rest]) -> + io:format(" ", []), + print_var(Var), + io:format(",", []), + print_live_list(Rest). + +pp_block(Label, CFG) -> + BB = hipe_icode_cfg:bb(CFG, Label), + Code = hipe_bb:code(BB), + hipe_icode_pp:pp_block(Code). + +print_var(#icode_variable{name=V, kind=Kind, annotation=T}) -> + case Kind of + var -> io:format("v~p", [V]); + reg -> io:format("r~p", [V]); + fvar -> io:format("fv~p", [V]) + end, + case T of + [] -> ok; + {_,X,F} -> io:format(" (~s)", F(X)) + end. + +%% +%% The following are used only if annotation of the code is requested. +%% +-ifdef(DEBUG_LIVENESS). +cfg_bb_add(CFG, L, NewBB) -> + hipe_icode_cfg:bb_add(CFG, L, NewBB). + +mk_comment(Text) -> + hipe_icode:mk_comment(Text). +-endif. diff --git a/lib/hipe/icode/hipe_icode_mulret.erl b/lib/hipe/icode/hipe_icode_mulret.erl new file mode 100644 index 0000000000..a6529c8519 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_mulret.erl @@ -0,0 +1,1323 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-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_icode_mulret.erl +%% Author : Christoffer Vikström +%% Purpose : +%% Created : 23 Jun 2004 by Christoffer Vikström +%%---------------------------------------------------------------------- + +-module(hipe_icode_mulret). +-export([mult_ret/4]). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). + +%%>----------------------------------------------------------------------< +%% Procedure : mult_ret/4 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< + +-spec mult_ret([_], atom(), comp_options(), _) -> [_]. + +mult_ret(List, Mod, Opts, Exports) -> + case length(List) > 1 of + true -> + Table = analyse(List, Mod, Exports), + %% printTable(Mod, Exports, Table), + optimize(List, Mod, Opts, Table); + false -> + List + end. + +%%>-----------------------< Analysis Steps >-----------------------------< + +%%>----------------------------------------------------------------------< +%% Procedure : analyse/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +analyse(List, _Mod, Exports) -> + MaxRets = hipe_rtl_arch:nr_of_return_regs(), + Table = mkTable(List), + %% printTable(Mod, Exports, Table), + Table2 = filterTable(Table, MaxRets, Exports), + %% printTable(Mod, Exports, Table2), + Table2. + +%%>----------------------------------------------------------------------< +%% Procedure : mkTable/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +mkTable(List) -> + mkTable(List, {[], []}). + +mkTable([{MFA, Icode} | List], Table) -> + %% New Icode + {_LMin,LMax} = hipe_icode:icode_label_range(Icode), + hipe_gensym:set_label(icode, LMax+1), + {_VMin,VMax} = hipe_icode:icode_var_range(Icode), + hipe_gensym:set_var(icode, VMax+1), + case isFunDef(MFA) of + true -> + mkTable(List, Table); + false -> + CallList = mkCallList(MFA, Icode), + Optimizable = isOptimizable(Icode), + NewTable = addToTable(MFA, Optimizable, CallList, Table), + mkTable(List, NewTable) + end; +mkTable([_|List], Table) -> mkTable(List, Table); +mkTable([], Table) -> Table. + +%%>----------------------------------------------------------------------< +%% Procedure : isFunDef/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +isFunDef({_, F, _}) -> + hd(atom_to_list(F)) =:= 45. %% 45 is the character '-' + +%%>----------------------------------------------------------------------< +%% Procedure : mkCallList/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +mkCallList(MFA, Icode) -> + Code = hipe_icode:icode_code(Icode), + mkCallList(Code, MFA, []). + +mkCallList([#icode_call{'fun'=F, dstlist=Vars, type=local}|Code], MFA, Res) -> + {Size, DstList} = lookForDef(Code, Vars), + mkCallList(Code, MFA, [{callPair,MFA,{F,{matchSize,Size,DstList}}}|Res]); +mkCallList([_|Code], MFA, Res) -> mkCallList(Code, MFA, Res); +mkCallList([], _, Res) -> Res. + +%%>----------------------------------------------------------------------< +%% Procedure : lookForDef/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +lookForDef([#icode_type{test={tuple,Size}, true_label=L}|Code], Vars) -> + Code2 = skipToLabel(Code, L), + DstLst = lookForUnElems(Code2, Vars), + case DstLst of + [] -> {1, Vars}; + _ -> + DstLst2 = fixDstLst(DstLst, Size), + {Size, DstLst2} + end; +lookForDef([#icode_move{src=Var, dst=NewVar}|Code], [Var]) -> + lookForDef(Code, [NewVar]); +lookForDef([#icode_label{}|_], Vars) -> + {1, Vars}; +lookForDef([I|Code], [Var] = Vars) -> + Defs = hipe_icode:defines(I), + case lists:member(Var, Defs) of + true -> + {1, Vars}; + false -> + lookForDef(Code, Vars) + end; +lookForDef([], Vars) -> {1, Vars}. + +%%>----------------------------------------------------------------------< +%% Procedure : skipToLabel/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +skipToLabel(Code, L) -> + case skipToLabel2(Code, L) of + noLabel -> + Code; + NewCode -> + NewCode + end. + +skipToLabel2([#icode_label{name = L}|Code],L) -> Code; +skipToLabel2([_|Code], L) -> skipToLabel2(Code, L); +skipToLabel2([], _) -> noLabel. + +%%>----------------------------------------------------------------------< +%% Procedure : lookForUnElems/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +lookForUnElems(Code, Var) -> + lookForUnElems(Code, Var, []). + +lookForUnElems([#icode_call{'fun'=#unsafe_element{index=Nr}, args=Var, + dstlist=[Ret]}|Code], Var, Res) -> + lookForUnElems(Code, Var, [{Nr, Ret}|Res]); +lookForUnElems([#icode_move{dst=Var}|_], [Var], Res) -> + lists:flatten(Res); +lookForUnElems([#icode_call{dstlist=VarList}|_], VarList, Res) -> + lists:flatten(Res); +lookForUnElems([_|Code], Var, Res) -> + lookForUnElems(Code, Var, Res); +lookForUnElems([], _, Res) -> lists:flatten(Res). + +%%>----------------------------------------------------------------------< +%% Procedure : fixDstLst/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +fixDstLst(DstLst, Size) when is_integer(Size) -> + fixDstLst(DstLst, Size, 1, []). + +fixDstLst(DstLst, Size, Cnt, Res) when Cnt =< Size -> + case isInLst(Cnt, DstLst) of + {true, Var} -> + fixDstLst(DstLst, Size, Cnt+1, [Var|Res]); + false -> + Var = hipe_icode:mk_var(hipe_gensym:new_var(icode)), + fixDstLst(DstLst, Size, Cnt+1, [Var|Res]) + end; +fixDstLst(_, Size, Cnt, Res) when Cnt > Size -> lists:reverse(Res). + +%%>----------------------------------------------------------------------< +%% Procedure : isInLst/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +isInLst(Nr, [{Nr,Var}|_]) -> {true, Var}; +isInLst(Cnt, [_|DstLst]) -> isInLst(Cnt, DstLst); +isInLst(_, []) -> false. + +%%>----------------------------------------------------------------------< +%% Procedure : isOptimizable/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +isOptimizable(Icode) -> + %% Icode2 = hipe_icode:fixup_fallthroughs(Icode), + Icode2 = hipe_icode:strip_comments(Icode), + Cfg = hipe_icode_cfg:linear_to_cfg(Icode2), + %% hipe_icode_cfg:pp(Cfg), + case findReturnBlocks(Cfg) of + noReturn -> + {false, -1}; + BlockList -> + processReturnBlocks(BlockList, Cfg) + end. + +%%>----------------------------------------------------------------------< +%% Procedure : findReturnBlocks/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +findReturnBlocks(IcodeCfg) -> + Labels = hipe_icode_cfg:labels(IcodeCfg), + case searchBlocks(Labels, IcodeCfg) of + [] -> + noReturn; + BlockList-> + BlockList + end. + +%%>----------------------------------------------------------------------< +%% Procedure : searchBlocks/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +searchBlocks(Labels, IcodeCfg) -> + searchBlocks(Labels, IcodeCfg, []). + +searchBlocks([Label|Labels], IcodeCfg, Res) -> + Block = hipe_icode_cfg:bb(IcodeCfg, Label), + Code = hipe_bb:code(Block), + case searchBlockCode(Code) of + {hasReturn, RetVar} -> + searchBlocks(Labels, IcodeCfg, [{Label, RetVar}|Res]); + noReturn -> + searchBlocks(Labels, IcodeCfg, Res) + end; +searchBlocks([], _, Res) -> Res. + +%%>----------------------------------------------------------------------< +%% Procedure : searchBlockCode/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +searchBlockCode([#icode_return{vars=Vars}|_]) -> + {hasReturn, Vars}; +searchBlockCode([_|Icode]) -> + searchBlockCode(Icode); +searchBlockCode([]) -> noReturn. + +%%>----------------------------------------------------------------------< +%% Procedure : processReturnBlock/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +processReturnBlocks(Blocks, Cfg) -> + processReturnBlocks(Blocks, Cfg, {true, -1}, []). + +processReturnBlocks([{Label, Var}|BlockList], Cfg, {Opts, Size}, TypeLst) -> + {Opt, Type, Size2} = traverseCode(Label, Var, Cfg), + case (Size =:= -1) orelse (Size =:= Size2) of + true -> + processReturnBlocks(BlockList, Cfg, + {Opt andalso Opts, Size2}, [Type|TypeLst]); + false -> + {false, -1} + end; +processReturnBlocks([], _, Res, TypeLst) -> + case lists:member(icode_var, TypeLst) of + true -> + {_, Size} = Res, + case Size > 1 of + true -> + Res; + false -> + {false, -1} + end; + false -> + {false, -1} + end. + +%%>----------------------------------------------------------------------< +%% Procedure : traverseCode/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +traverseCode(Label, Var, Cfg) -> + traverseCode(Label, Var, Cfg, []). + +traverseCode(Label, Var, Cfg, LabLst) -> + Preds = hipe_icode_cfg:pred(Cfg, Label), + Block = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(Block), + case findDefine(lists:reverse(Code), Var) of + {found, Type, NumRets} -> + {true, Type, NumRets}; + {notFound, SrcVar} -> + case Preds of + [] -> + {false, none, -1}; + [Pred] -> + case lists:member(Label, LabLst) of + false -> + traverseCode(Pred, SrcVar, Cfg, [Label|LabLst]); + true -> + {false, none, -1} + end; + _ -> + {false, none, -1} + end + end. + +%%>----------------------------------------------------------------------< +%% Procedure : findDefine/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +findDefine([#icode_call{dstlist=Vars,'fun'=mktuple,args=Vs}|_], Vars) -> + case length(Vs) of + 1 -> + [{Type, _}] = Vs, + {found, Type, 1}; + Len -> + case lists:any(fun hipe_icode:is_var/1, Vs) of + true -> + {found, icode_var, Len}; + false -> + {found, icode_const, Len} + end + end; +findDefine([#icode_move{dst=Var, src=Src}|Code], [Var]) -> + case hipe_icode:is_var(Src) of + true -> + findDefine(Code, [Src]); + false -> + case Src of + #icode_const{value={flat, Value}} -> + case is_tuple(Value) of + true -> + {found, icode_const, tuple_size(Value)}; + false -> + {found, icode_const, 1} + end; + _ -> + findDefine(Code, [Var]) + end + end; +findDefine([_|Code], Var) -> + findDefine(Code, Var); +findDefine([], Var) -> + {notFound, Var}. + +%%>----------------------------------------------------------------------< +%% Procedure : addToTable/4 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +addToTable(MFA, Optimizable, CallList, {FunLst, CallLst}) -> + NewFunLst = [{MFA, Optimizable}|FunLst], + {NewFunLst, CallList ++ CallLst}. + +%%>----------------------------------------------------------------------< +%% Procedure : filterTable/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +filterTable({FunLst, CallLst}, MaxRets, Exports) -> + filterTable(FunLst, CallLst, MaxRets, Exports, {[],[]}). + +filterTable([Fun|FunLst], CallLst, MaxRets, Exports, {Funs, Calls} = FCs) -> + {MFA, {ReturnOpt, Rets}} = Fun, + {CallOpt, CallsToKeep} = checkCalls(CallLst, MFA, Rets), + CallsToKeep2 = removeDuplicateCalls(CallsToKeep), + NotExported = checkExported(MFA, Exports), + case CallOpt andalso ReturnOpt andalso (Rets =< MaxRets) andalso + NotExported andalso (not containRecursiveCalls(CallsToKeep2, MFA)) of + true -> + filterTable(FunLst, CallLst, MaxRets, Exports, + {[Fun|Funs], CallsToKeep2 ++ Calls}); + false -> + filterTable(FunLst, CallLst, MaxRets, Exports, FCs) + end; +filterTable([], _, _, _, Res) -> Res. + +removeDuplicateCalls(Calls) -> + removeDuplicateCalls(Calls, []). + +removeDuplicateCalls([Call|CallsToKeep], Res) -> + case lists:member(Call, CallsToKeep) of + true -> + removeDuplicateCalls(CallsToKeep, Res); + false -> + removeDuplicateCalls(CallsToKeep, [Call|Res]) + end; +removeDuplicateCalls([], Res) -> lists:reverse(Res). + +containRecursiveCalls([Call|Calls], Fun) -> + {callPair, Caller, {Callee, _}} = Call, + case (Callee =:= Fun) andalso (Caller =:= Fun) of + true -> + true; + false-> + containRecursiveCalls(Calls, Fun) + end; +containRecursiveCalls([], _) -> false. + +%%>----------------------------------------------------------------------< +%% Procedure : checkCalls/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +checkCalls(CallLst, MFA, Rets) -> + checkCalls(CallLst, MFA, Rets, [], []). + +checkCalls([C = {callPair, _, {MFA, {matchSize, Rets, _}}}|CallLst], + MFA, Rets, Res, Opt) -> + checkCalls(CallLst, MFA, Rets, [C|Res], [true|Opt]); +checkCalls([{callPair, _, {MFA, {matchSize, _, _}}}|CallLst], + MFA, Rets, Res, Opt) -> + checkCalls(CallLst, MFA, Rets, Res, [false|Opt]); +checkCalls([_|CallLst], MFA, Rets, Res, Opt) -> + checkCalls(CallLst, MFA, Rets, Res, Opt); +checkCalls([], _, _, Res, Opt) -> {combineOpts(Opt), Res}. + +%%>----------------------------------------------------------------------< +%% Procedure : combineOpts/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +combineOpts([]) -> false; +combineOpts([Opt]) -> Opt; +combineOpts([Opt|Opts]) -> Opt andalso combineOpts(Opts). + +%%>----------------------------------------------------------------------< +%% Procedure : checkCalls/2 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +checkExported({_,F,A}, [{F,A}|_]) -> false; +checkExported(MFA, [_|Exports]) -> checkExported(MFA, Exports); +checkExported(_, []) -> true. + +%%>----------------------< Optimization Steps >--------------------------< + +%%>----------------------------------------------------------------------< +%% Procedure : optimize/4 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +optimize(List, _Mod, Opts, Table) -> + {FunLst, CallLst} = Table, + List2 = optimizeFuns(FunLst, Opts, List), + optimizeCalls(CallLst, Opts, List2). + +%%>----------------------------------------------------------------------< +%% Procedure : optimizeFuns/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +optimizeFuns([{Fun, _}|FunList], Opts, List) -> + NewList = findFun(List, Fun), + optimizeFuns(FunList, Opts, NewList); +optimizeFuns([],_,List) -> List. + +findFun(List, Fun) -> findFun(List, Fun, []). +findFun([{Fun, Icode}|List], Fun, Res) -> + NewIcode = optimizeFun(Icode), + findFun(List, Fun, [{Fun, NewIcode}|Res]); +findFun([I|List], Fun, Res) -> findFun(List, Fun, [I|Res]); +findFun([], _, Res) -> lists:reverse(Res). + + +optimizeFun(Icode) -> + {_LMin,LMax} = hipe_icode:icode_label_range(Icode), + hipe_gensym:set_label(icode, LMax+1), + {_VMin,VMax} = hipe_icode:icode_var_range(Icode), + hipe_gensym:set_var(icode, VMax+1), + %% Icode2 = hipe_icode:fixup_fallthroughs(Icode), + Icode2 = hipe_icode:strip_comments(Icode), + Cfg = hipe_icode_cfg:linear_to_cfg(Icode2), + case findReturnBlocks(Cfg) of + noReturn -> + false; + BlockList -> + NewCfg = optimizeReturnBlocks(BlockList, Cfg), + hipe_icode_cfg:cfg_to_linear(NewCfg) + end. + +optimizeReturnBlocks([Block|BlockList], Cfg) -> + {NewCfg, Vars} = optimizeReturnBlock(Block, Cfg), + NewCfg2 = case Vars of + [_] -> + Cfg; + _ -> + {Label, _} = Block, + updateReturnBlock(Label, Vars, NewCfg) + end, + optimizeReturnBlocks(BlockList, NewCfg2); +optimizeReturnBlocks([], Cfg) -> Cfg. + +optimizeReturnBlock(Block, Cfg) -> + optimizeReturnBlock(Block, Cfg, []). + +optimizeReturnBlock({Label,Var}, Cfg, UpdateMap) -> + Preds = hipe_icode_cfg:pred(Cfg, Label), + Block = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(Block), + case optimizeDefine(Code, Var) of + {found, NewBlockCode, Vars} -> + NewBlock = hipe_bb:code_update(Block, NewBlockCode), + NewCfg = resolveUpdateMap(UpdateMap, Cfg), + {hipe_icode_cfg:bb_add(NewCfg, Label, NewBlock), Vars}; + {none, NewBlockCode, NewVar} -> + case Preds of + [Pred] -> + NewBlock = hipe_bb:code_update(Block, NewBlockCode), + optimizeReturnBlock({Pred,NewVar}, Cfg, + [{Label, NewBlock}|UpdateMap]); + [_|_] -> + {Cfg, Var} + end; + {none, noOpt} -> + {Cfg, Var} + end. + +optimizeDefine(Code, Dst) -> + optimizeDefine(lists:reverse(Code), Dst, [], []). + +optimizeDefine([I|Code], Dsts, DstLst, Res) -> + [Ds] = Dsts, + case isCallPrimop(I, mktuple) andalso DstLst =:= [] of + true -> + case (hipe_icode:call_dstlist(I) =:= Dsts) of + true -> + case (hipe_icode:call_args(I) > 1) of + true -> + optimizeDefine(Code, Dsts, hipe_icode:call_args(I), Res); + false -> + {none, noOpt} + end; + false -> + optimizeDefine(Code, Dsts, DstLst, [I|Res]) + end; + false -> + case hipe_icode:is_move(I) andalso DstLst =:= [] of + true -> + case hipe_icode:move_dst(I) =:= Ds of + true -> + Src = hipe_icode:move_src(I), + case hipe_icode:is_var(Src) of + true -> + NewDst = hipe_icode:move_src(I), + optimizeDefine(Code, [NewDst], DstLst, Res); + false -> + case Src of + #icode_const{value={flat, T}} when is_tuple(T) -> + NewLst = tuple_to_list(T), + optimizeDefine(Code, Dsts, NewLst, Res); + _ -> + {none, noOpt} + end + end; + false -> + optimizeDefine(Code, Dsts, DstLst, [I|Res]) + end; + false -> + case lists:member(Ds, hipe_icode:defines(I)) andalso DstLst =:= [] of + true -> + {none, noOpt}; + false -> + optimizeDefine(Code, Dsts, DstLst, [I|Res]) + end + end + end; +optimizeDefine([], Dsts, DstLst, Res) -> + case DstLst of + [] -> + {none, Res, Dsts}; + _ -> + {found, Res, DstLst} + end. + +resolveUpdateMap([{Label, Block}|UpdateMap], Cfg) -> + resolveUpdateMap(UpdateMap, hipe_icode_cfg:bb_add(Cfg, Label, Block)); +resolveUpdateMap([], Cfg) -> Cfg. + +%%>----------------------------------------------------------------------< +%% Procedure : updateReturnBlock/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +updateReturnBlock(Label, Vars, IcodeCfg) -> + Block = hipe_icode_cfg:bb(IcodeCfg, Label), + Code = hipe_bb:code(Block), + NewCode = updateReturnCode(Code, Vars), + NewBlock = hipe_bb:code_update(Block, NewCode), + hipe_icode_cfg:bb_add(IcodeCfg, Label, NewBlock). + +updateReturnCode(Code, DstLst) -> + updateReturnCode(Code, DstLst, []). + +updateReturnCode([I| Code], DstLst, Res) -> + case hipe_icode:is_return(I) of + true -> + updateReturnCode(Code, DstLst, [hipe_icode:mk_return(DstLst)|Res]); + false -> + updateReturnCode(Code, DstLst, [I|Res]) + end; +updateReturnCode([], _, Res) -> lists:reverse(Res). + +%%>----------------------------------------------------------------------< +%% Procedure : optimizeCalls/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +optimizeCalls([Call|CallLst], _Opts, List) -> + {callPair, Caller, {Callee, {matchSize, _, DstLst}}} = Call, + NewList = optimizeCall(List, Caller, Callee, DstLst), + optimizeCalls(CallLst, _Opts, NewList); +optimizeCalls([], _Opts, List) -> List. + +%%>----------------------------------------------------------------------< +%% Procedure : optimizeCall/4 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +optimizeCall(List, Caller, Callee, DstLst) -> + optimizeCall(List, Caller, Callee, DstLst, []). + +optimizeCall([{MFA, Icode}|List], MFA, Callee, DstLst, Res) -> + {_LMin,LMax} = hipe_icode:icode_label_range(Icode), + hipe_gensym:set_label(icode, LMax+1), + {_VMin,VMax} = hipe_icode:icode_var_range(Icode), + hipe_gensym:set_var(icode, VMax+1), + %% Icode2 = hipe_icode:fixup_fallthroughs(Icode), + Icode2 = hipe_icode:strip_comments(Icode), + Cfg = hipe_icode_cfg:linear_to_cfg(Icode2), + NewIcode = findAndUpdateCalls(Cfg, Callee, DstLst), + optimizeCall(List, MFA, Callee, DstLst, [{MFA, NewIcode}|Res]); +optimizeCall([I|List], Caller, Callee, DstLst, Res) -> + optimizeCall(List, Caller, Callee, DstLst, [I|Res]); +optimizeCall([], _, _, _, Res) -> lists:reverse(Res). + +%%>----------------------------------------------------------------------< +%% Procedure : findAndUpdateCall/3 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +findAndUpdateCalls(Cfg, Callee, DstLst) -> + Labels = hipe_icode_cfg:labels(Cfg), + Cfg2 = findAndUpdateCalls(Cfg, Labels, Callee, DstLst, []), + hipe_icode_cfg:cfg_to_linear(Cfg2). +findAndUpdateCalls(Cfg, [L|Labels], Callee, DstLst, Visited) -> + %% Block = hipe_icode_cfg:bb(Cfg, L), + %% Code = hipe_bb:code(Block), + case containCorrectCall(Cfg, L, Callee, DstLst) of + true -> + Block = hipe_icode_cfg:bb(Cfg,L), + Code = hipe_bb:code(Block), + {NewCode, OldVar} = updateCode(Code, Callee, DstLst), + NewBlock = hipe_bb:code_update(Block, NewCode), + Cfg2 = hipe_icode_cfg:bb_add(Cfg, L, NewBlock), + Cfg3 = cleanUpAffectedCode(Cfg2, OldVar, Callee, L, Visited), + findAndUpdateCalls(Cfg3, Labels, Callee, DstLst, [L|Visited]); + false -> + findAndUpdateCalls(Cfg, Labels, Callee, DstLst, [L|Visited]) + end; +findAndUpdateCalls(Cfg,[], _, _, _) -> Cfg. + +containCorrectCall(Cfg, Label, Callee, DstLst) -> + Block = hipe_icode_cfg:bb(Cfg,Label), + Code = hipe_bb:code(Block), + case containCallee(Code, Callee) of + {true, OldVar} -> + Succs = hipe_icode_cfg:succ(Cfg, Label), + checkForUnElems(Succs, OldVar, DstLst, Cfg); + false -> + false + end. + +checkForUnElems([], _, _, _) -> false; +checkForUnElems([Succ|Succs], OldVar, DstLst, Cfg) -> + Block = hipe_icode_cfg:bb(Cfg,Succ), + Code = hipe_bb:code(Block), + case checkForUnElems2(Code, OldVar, DstLst, []) of + true -> + true; + false -> + checkForUnElems(Succs, OldVar, DstLst, Cfg) + end. + +checkForUnElems2([I|Code], OldVar, DstLst, DstRes) -> + case isCallPrimop(I, unsafe_element) of + true -> + case (hipe_icode:call_args(I) =:= OldVar) of + true -> + [Dst] = hipe_icode:call_dstlist(I), + case lists:member(Dst, DstLst) of + true -> + checkForUnElems2(Code, OldVar, DstLst, [Dst|DstRes]); + false -> + checkForUnElems2(Code, OldVar, DstLst, DstRes) + end; + false -> + checkForUnElems2(Code, OldVar, DstLst, DstRes) + end; + false -> + checkForUnElems2(Code, OldVar, DstLst, DstRes) + end; +checkForUnElems2([], _, DstLst, DstRes) -> DstLst =:= lists:reverse(DstRes). + + +containCallee([I|Code], Callee) -> + case isCallLocal(I, Callee) of + true -> + {true, hipe_icode:call_dstlist(I)}; + false -> + containCallee(Code, Callee) + end; +containCallee([], _) -> false. + + +updateCode(Code, Callee, DstLst) -> + updateCode(Code, Callee, DstLst, [], []). + +updateCode([I|Code], Callee, DstLst, Res, OldVars) -> + case isCallLocal(I, Callee) of + true -> + Vars = hipe_icode:call_dstlist(I), + I2 = hipe_icode:call_dstlist_update(I, DstLst), + updateCode(Code, Callee, DstLst, [I2|Res], Vars); + false -> + updateCode(Code, Callee, DstLst, [I|Res], OldVars) + end; +updateCode([], _, _, Res, OldVars) -> {lists:reverse(Res), OldVars}. + + +cleanUpAffectedCode(Cfg, OldVar, Callee, Label, Visited) -> + Block = hipe_icode_cfg:bb(Cfg,Label), + Code = hipe_bb:code(Block), + {CodeBefore, CodeAfter, DstLst} = divideAtCall(Code, Callee), + {NewCodeAfter, ContLab, FailLab} = findType(CodeAfter, OldVar), + ContBlock = hipe_icode_cfg:bb(Cfg, ContLab), + Succs = hipe_icode_cfg:succ(Cfg, ContLab), + ContCode = hipe_bb:code(ContBlock), + {NewContCode, NewFailLab} = removeUnElems(ContCode, OldVar, DstLst), + NewBlock = hipe_bb:code_update(Block, + CodeBefore ++ NewCodeAfter ++ NewContCode), + Cfg2 = hipe_icode_cfg:bb_add(Cfg, Label, NewBlock), + Cfg3 = resolveSuccBlocks(Succs, OldVar, DstLst, [Label|Visited], + NewFailLab, Cfg2), + insertMiddleFailBlock(Cfg3, NewFailLab, FailLab, OldVar, DstLst). + +divideAtCall(Code, Caller) -> + divideAtCall(Code, Caller, []). + +divideAtCall([I|Code], Caller, Tail) -> + case isCallLocal(I, Caller) of + true -> + {lists:reverse([I|Tail]), Code, hipe_icode:call_dstlist(I)}; + false -> + divideAtCall(Code, Caller, [I|Tail]) + end; +divideAtCall([], _, Tail) -> {Tail, []}. + +findType(CodeAfter, OldVar) -> + findType(CodeAfter, OldVar, [], {none, none}). + +findType([I|Code], OldVar, Rest, Succs) -> + case hipe_icode:is_type(I) of + true -> + case hipe_icode:type_args(I) =:= OldVar of + true -> + TrueLab = hipe_icode:type_true_label(I), + FalseLab = hipe_icode:type_false_label(I), + findType(Code, OldVar, Rest, {TrueLab, FalseLab}); + false -> + findType(Code, OldVar, [I|Rest], Succs) + end; + false -> + case hipe_icode:is_move(I) of + true -> + case [hipe_icode:move_src(I)] =:= OldVar of + true -> + findType(Code, hipe_icode:move_dst(I), [I|Rest], Succs); + false -> + findType(Code, OldVar, [I|Rest], Succs) + end; + false -> + findType(Code, OldVar, [I|Rest], Succs) + end + end; +findType([],_,Rest, {TrueLab, FalseLab}) -> + {lists:reverse(Rest), TrueLab, FalseLab}. + +%% Nesting hell... check for redundancies. +%% --------------------------------------- +removeUnElems(Code, OldVars, DstLst) -> + removeUnElems(Code, OldVars, DstLst, [], false, none). + +removeUnElems([I|Code], [OldVar] = OldVars, DstLst, Res, Def, Lab) -> + case isCallPrimop(I, unsafe_element) of + true -> + case (hipe_icode:call_args(I) =:= OldVars) of + true -> + removeUnElems(Code, OldVars, DstLst, Res, Def, Lab); + false -> + case lists:member(OldVar, hipe_icode:call_args(I)) of + true -> + %% XXX: the following test seems redundant, + %% hence commented out -- KOSTIS + %% case Def of + %% true -> + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab); + %% false -> + %% removeUnElems(Code, OldVars, DstLst, + %% [I|Res], Def, Lab) + %% end; + false -> + io:format("Borde aldrig kunna hamna här!", []), + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab) + end + end; + false -> + case hipe_icode:is_move(I) of + true -> + case hipe_icode:move_src(I) =:= OldVar of + true -> + NewVar = hipe_icode:move_dst(I), + removeUnElems(Code, [NewVar], DstLst, [I|Res], Def, Lab); + false -> + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab) + end; + false -> + case hipe_icode:is_type(I) andalso not Def of + true -> + NewFalseLab = case Lab =:= none of + true -> + hipe_gensym:get_next_label(icode); + false -> + Lab + end, + _I2 = updateTypeFalseLabel(I, NewFalseLab), + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, NewFalseLab); + false -> + case lists:member(OldVar, hipe_icode:uses(I)) andalso Def of + true -> + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab); + false -> + case lists:member(OldVar, hipe_icode:defines(I)) of + true -> + removeUnElems(Code, OldVars, DstLst, [I|Res], true, Lab); + false -> + removeUnElems(Code, OldVars, DstLst, [I|Res], Def, Lab) + end + end + end + end + end; +removeUnElems([], _, _, Res,_, Lab) -> {lists:reverse(Res), Lab}. + + +updateTypeFalseLabel(Instr, NewFalseLabel) -> + TrueLabel = hipe_icode:type_true_label(Instr), + Args = hipe_icode:type_args(Instr), + Type = hipe_icode:type_test(Instr), + hipe_icode:mk_type(Args, Type, TrueLabel, NewFalseLabel). + + +resolveSuccBlocks(Succs, OldVar, DstLst, Visited, FailLab, Cfg) -> + NewSuccs = [X || X <- Succs, not lists:member(X, Visited)], + resolveSuccBlocks2(NewSuccs, OldVar, DstLst, Visited, FailLab, Cfg). + +resolveSuccBlocks2([Succ|Succs], OldVar, DstLst, Vis, FailLab, Cfg) -> + Block = hipe_icode_cfg:bb(Cfg,Succ), + Code = hipe_bb:code(Block), + {NewCode, ReDefined} = checkUsesDefs(Code, OldVar, DstLst, FailLab), + NewBlock = hipe_bb:code_update(Block, NewCode), + Cfg2 = hipe_icode_cfg:bb_add(Cfg, Succ, NewBlock), + case ReDefined of + true -> + resolveSuccBlocks2(Succs, OldVar, DstLst, [Succ|Vis], FailLab, Cfg2); + false -> + NewSuccs = hipe_icode_cfg:succ(Cfg, Succ), + NewSuccs2 = [X || X <- NewSuccs, not lists:member(X, Vis++Succs)], + resolveSuccBlocks2(NewSuccs2++Succs, OldVar, DstLst, + [Succ|Vis], FailLab, Cfg2) + end; +resolveSuccBlocks2([], _, _, _, _, Cfg) -> Cfg. + + +checkUsesDefs(Code, OldVar, DstLst, FailLab) -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [], false). + +checkUsesDefs([I|Code], OldVar, DstLst, FailLab, Res, Defined) -> + [OVar] = OldVar, + case hipe_icode:is_move(I) of + true -> + case hipe_icode:move_src(I) =:= OVar of + true -> + NewVar = hipe_icode:move_dst(I), + checkUsesDefs(Code, NewVar, DstLst, FailLab, [I|Res], true); + false -> + case lists:member(OVar, hipe_icode:defines(I)) of + true -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], true); + false -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined) + end + end; + false -> + case hipe_icode:is_type(I) andalso not Defined of + true -> + case FailLab =/= none of + true -> + _I2 = updateTypeFalseLabel(I, FailLab), + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined); + false -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], Defined) + end; + false -> + case (lists:member(OVar, hipe_icode:uses(I))) andalso + (not Defined) andalso (FailLab =/= none) of + true -> + Tpl = hipe_icode:mk_primop(OldVar, mktuple, DstLst), + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I,Tpl|Res], true); + false -> + case lists:member(OVar, hipe_icode:defines(I)) of + true -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res], true); + false -> + checkUsesDefs(Code, OldVar, DstLst, FailLab, [I|Res],Defined) + end + end + end + end; +checkUsesDefs([], _, _, _, Res, Defined) -> {lists:reverse(Res), Defined}. + + +insertMiddleFailBlock(Cfg, NewFailLabel, OldFailLabel, OldVar, DstLst) -> + case NewFailLabel =:= none of + true -> + Cfg; + false -> + NewCode = [hipe_icode:mk_primop(OldVar, mktuple, DstLst), + hipe_icode:mk_goto(OldFailLabel)], + NewBlock = hipe_bb:mk_bb(NewCode), + hipe_icode_cfg:bb_add(Cfg, NewFailLabel, NewBlock) + end. + + +isCallLocal(Instr, Fun) -> + hipe_icode:is_call(Instr) andalso (hipe_icode:call_type(Instr) =:= local) + andalso (hipe_icode:call_fun(Instr) =:= Fun). + +isCallPrimop(Instr, Fun) -> + case hipe_icode:is_call(Instr) of + true -> + case is_tuple(hipe_icode:call_fun(Instr)) of + true -> + ((hipe_icode:call_type(Instr) =:= primop) andalso + (element(1,hipe_icode:call_fun(Instr)) =:= Fun)); + false -> + ((hipe_icode:call_type(Instr) =:= primop) andalso + (hipe_icode:call_fun(Instr) =:= Fun)) + end; + false -> + false + end. + + +%% >-------------------------< Debug code >------------------------------< + +-ifdef(DEBUG_MULRET). + +%%>----------------------------------------------------------------------< +%% Procedure : printTable/1 +%% Purpose : +%% Arguments : +%% Return : +%% Notes : +%%>----------------------------------------------------------------------< +printTable(Mod, Exports, {FunLst, CallLst}) -> + {Y,Mo,D} = date(), + {H,Mi,S} = time(), + io:format("Module: ~w - (~w/~w-~w, ~w:~w:~w)~n=======~n", + [Mod,D,Mo,Y,H,Mi,S]), + io:format("Exports: ~w~n", [Exports]), + io:format("FunList: ~n"), + printFunList(FunLst), + io:format("CallList: ~n"), + printCallList(CallLst). + +printFunList([Fun|FunLst]) -> + io:format(" ~w~n", [Fun]), + printFunList(FunLst); +printFunList([]) -> io:format("~n"). + +printCallList([Call|CallLst]) -> + io:format(" ~w~n", [Call]), + printCallList(CallLst); +printCallList([]) -> io:format("~n"). + +-endif. + +%% >----------------------------< Old code >--------------------------------< + +%% %%>----------------------------------------------------------------------< +%% % Procedure : findCallCode/3 +%% % Purpose : +%% % Arguments : +%% % Return : +%% % Notes : +%% %%>----------------------------------------------------------------------< +%% findCallCode(List, Callee, DstLst) -> findCallCode(List, Callee, DstLst, []). +%% findCallCode([I=#icode_call{'fun'=Callee, dstlist=Var, type=local}, I2, I3|List], +%% Callee, DstLst, Res) -> +%% NewList = removeUnElems(List, Var), +%% %% _Uses = checkForUses(NewList, Var, DstLst), +%% Size = length(DstLst), +%% case I2 of +%% #icode_type{test={tuple, Size}, args=Var, true_label=Label} -> +%% case I3 of +%% #icode_label{name=Label} -> +%% findCallCode(NewList, Callee, DstLst, +%% [I#icode_call{dstlist=DstLst}|Res]); +%% _ -> +%% findCallCode(NewList, Callee, DstLst, +%% [#goto{label=Label}, +%% I#icode_call{dstlist=DstLst}|Res]) +%% end; +%% _ -> +%% findCallCode(NewList, Callee, DstLst, +%% [I2,I#icode_call{dstlist=DstLst}|Res]) +%% end; +%% findCallCode([I|List], Callee, DstLst, Res) -> +%% findCallCode(List, Callee, DstLst, [I|Res]); +%% findCallCode([], _, _, Res) -> lists:reverse(Res). + + +%% %%>----------------------------------------------------------------------< +%% % Procedure : checkForUses +%% % Purpose : +%% % Arguments : +%% % Return : +%% % Notes : +%% %%>----------------------------------------------------------------------< +%% checkForUses(List, Var, Dsts) -> checkForUses(List, Var, Dsts, [], List). +%% checkForUses([I|List], Var, Dsts, Rest, Code) -> +%% Defs = hipe_icode:defines(I), +%% Uses = hipe_icode:uses(I), +%% case lists:member(Var, Uses) of +%% true -> +%% true; +%% false -> +%% case lists:member(Var, Defs) of +%% true -> +%% false; +%% false -> +%% case hipe_icode:is_branch(I) of +%% true -> +%% Succs = hipe_icode:successors(I), +%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code); +%% false -> +%% checkForUses(List, Var, Dsts, [I|Rest], Code) +%% end +%% end +%% end; +%% checkForUses([], _, _, _, _) -> false. + +%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code) -> +%% checkSuccsForUses(Succs, Var, Dsts, Rest, Code, false). +%% checkSuccsForUses([S|Succs], Var, Dsts, Rest, Code, Res) -> +%% List = gotoLabel(S, Code), +%% Used = checkForUses(List, Var, Dsts, Rest, Code), +%% checkSuccsForUses(Succs, Var, Code, Dsts, Used andalso Res); +%% checkSuccsForUses([], _, _, _, _, Res) -> Res. + +%% gotoLabel(L, [L|List]) -> List; +%% gotoLabel(L, [_|List]) -> gotoLabel(L, List); +%% gotoLabel(_, []) -> []. + + +%% %%>----------------------------------------------------------------------< +%% % Procedure : removeUnElems/2 +%% % Purpose : +%% % Arguments : +%% % Return : +%% % Notes : Fixa så att funktionen använder defines(I) istället och +%% % selektorer istället för att matcha på #call{}. Lätt gjort. +%% %%>----------------------------------------------------------------------< +%% removeUnElems(List, Var) -> removeUnElems(List, Var, []). +%% removeUnElems([#icode_call{'fun'={unsafe_element,_}, args=Var}|List], Var, Res) -> +%% removeUnElems(List, Var, Res); +%% removeUnElems([I=#icode_move{dst=Var}|List], [Var], Res) -> +%% lists:reverse(Res) ++ [I|List]; +%% removeUnElems([I=#icode_call{dstlist=Var}|List], Var, Res) -> +%% lists:reverse(Res) ++ [I|List]; +%% removeUnElems([I|List], Var, Res) -> +%% removeUnElems(List, Var, [I|Res]); +%% removeUnElems([], _, Res) -> lists:reverse(Res). + +%% removeUnElems(List, Var) -> removeUnElems(List, Var, []). +%% removeUnElems([I|List], Var, Res) -> +%% Defs = hipe_icode:defines(I), +%% case hipe_icode:is_call(I) of +%% true -> +%% Fn = hipe_icode:call_fun(I), +%% case (hipe_icode:call_args(I) =:= Var) andalso is_tuple(Fn) of +%% true -> +%% case element(1,Fn) =:= unsafe_element of +%% true -> +%% removeUnElems(List, Var, Res); +%% false -> +%% case lists:member(Var, Defs) of +%% true -> +%% lists:reverse(Res) ++ [I|List]; +%% false -> +%% removeUnElems(List, Var, [I|Res]) +%% end +%% end; +%% false -> +%% case lists:member(Var, Defs) of +%% true -> +%% lists:reverse(Res) ++ [I|List]; +%% false -> +%% removeUnElems(List, Var, [I|Res]) +%% end +%% end; +%% false -> +%% case lists:member(Var, Defs) of +%% true -> +%% lists:reverse(Res) ++ [I|List]; +%% false -> +%% removeUnElems(List, Var, [I|Res]) +%% end +%% end; +%% removeUnElems([], _, Res) -> lists:reverse(Res). + + +%% Old findDefine that also could update it. +%% ----------------------------------------- +%% findDefine(Code, Var) -> findDefine(Code, Var, [], []). +%% findDefine([#icode_call{dstlist=Var,'fun'=mktuple,args=Vs}|Code],Var,NewCode,_)-> +%% findDefine(Code, Var, NewCode, Vs); +%% findDefine([I=#icode_move{dst=Var, src=Src}|Code], [Var], NewCode, _) -> +%% case Src of +%% #icode_var{} -> +%% findDefine(Code, [Src], [I|NewCode], [Src]); +%% #icode_const{value={flat, Tuple}} -> +%% findDefine(Code, [Var], [I|NewCode], []) %% Check this case! [Var] +%% end; +%% findDefine([I|Code], Var, NewCode, Vars) -> +%% findDefine(Code, Var, [I|NewCode], Vars); +%% findDefine([], _, NewCode, Vars) -> +%% case Vars of +%% [] -> +%% notFound; +%% [_] -> +%% {notFound, Vars}; +%% _ -> +%% {found, lists:reverse(NewCode), Vars} +%% end. + +%% modifyCode(Code, Var) -> +%% [#icode_return{vars=Var}|Code2] = lists:reverse(Code), +%% case (length(Var) =< hipe_rtl_arch:nr_of_return_regs()) of +%% true -> +%% {Arity, Code3} = modifyCode(Code2, Var, []), +%% {Arity, Code3}; +%% false -> +%% {1, Code} +%% end. + +%% modifyCode([I|Code], Var, Res) -> +%% case scanInstr(I, Var) of +%% {move, Arity, VarLst} -> +%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res) ++ Code], +%% {Arity, lists:reverse(Code2)}; +%% {mktuple, Arity, VarLst} -> +%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res) ++ Code], +%% {Arity, lists:reverse(Code2)}; +%% other -> +%% modifyCode(Code, Var, [I|Res]) +%% end; +%% modifyCode([], Var, Res) -> +%% {1, lists:reverse(Res) ++ [#icode_return{vars=Var}]}. + +%% scanInstr(#icode_call{dstlist=Var, 'fun'=mktuple, args=Lst}, Var) -> +%% {mktuple, length(Lst), Lst}; +%% scanInstr(_, _) -> other. + +%% printCode(Cfg) -> +%% Labels = hipe_icode_cfg:labels(Cfg), +%% {_,_,{_,F,_,_,_,_,_,_},_} = Cfg, +%% io:format("~nFunction: ~w~n", [F]), +%% Print = fun(Label) -> +%% Block = hipe_icode_cfg:bb(Cfg, Label), +%% Code = hipe_bb:code(Block), +%% io:format("Label: ~w~n", [Label]), +%% lists:foreach(fun(I) -> io:format("~w~n", [I]) end, Code), +%% io:format("~n") +%% end, +%% lists:foreach(Print, Labels). + +%% printList(File, [{MFA, #icode{code=Code, params=Parms}}|List]) -> +%% io:format(File, "MFA: ~w - Params: ~w~n", [MFA, Parms]), +%% printList2(File, Code), +%% printList(File, List); +%% printList(_, []) -> ok. + +%% printList2(File, []) -> io:format(File, "~n~n", []); +%% printList2(File, IList) when is_list(IList) -> +%% [I|List] = IList, +%% io:format(File, "~w~n", [I]), +%% printList2(File, List); +%% printList2(File, SomethingElse) -> +%% io:format(File, "Got: ~w~n", [SomethingElse]). + +%% optimizeDefine([#icode_call{dstlist=Var,'fun'=mktuple,args=Vs}|Code], +%% Var, _, Res) -> +%% case Vs of +%% [_] -> +%% {none, noOpt}; +%% _ -> +%% optimizeDefine(Code, Var, Vs, Res) +%% end; +%% optimizeDefine([I=#icode_move{dst=Var, src=Src}|Code], [Var], Rets, Res) -> +%% case hipe_icode:is_var(Src) of +%% true -> +%% optimizeDefine(Code, [Src], Rets, Res); +%% false -> +%% case Src of +%% #icode_const{value={flat, Tuple}} when is_tuple(Tuple) -> +%% optimizeDefine(Code, [Var], tuple_to_list(Tuple), [I|Res]); +%% #icode_const{value={flat, _}} -> +%% {none, noOpt}; +%% _ -> +%% optimizeDefine(Code, [Var], Rets, [I|Res]) +%% end +%% end; +%% optimizeDefine([I|Code], Var, Rets, Res) -> +%% optimizeDefine(Code, Var, Rets, [I|Res]); +%% optimizeDefine([], Var, Rets, Res) -> +%% case Rets of +%% [] -> +%% {none, Res, Var}; +%% _ -> +%% {found, Res, Rets} +%% end. diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl new file mode 100755 index 0000000000..575bbfe43d --- /dev/null +++ b/lib/hipe/icode/hipe_icode_pp.erl @@ -0,0 +1,303 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Copyright (c) 2003 by Erik Stenman. +%% ==================================================================== +%% Filename : hipe_icode_pp.erl +%% Module : hipe_icode_pp +%% Purpose : Pretty-printer for Icode. +%% Notes : +%% History : * 2003-04-16 (stenman@epfl.ch): Created. +%% CVS : +%% $Author$ +%% $Date$ +%% $Revision$ +%% ==================================================================== +%% +%% @doc +%% Icode Pretty-Printer. +%% @end +%% +%% ==================================================================== + +-module(hipe_icode_pp). + +-export([pp/1, pp/2, pp_block/1]). + +-ifdef(DEBUG_ICODE). +-export([pp_instrs/2]). +-endif. + +-include("hipe_icode.hrl"). + +%%--------------------------------------------------------------------- + +-spec pp(#icode{}) -> 'ok'. +%% @doc Prettyprints linear Icode on stdout. +%%

Badly formed or unknown instructions are printed surrounded +%% by three stars "***".

+pp(Icode) -> + pp(standard_io, Icode). + +-spec pp(io:device(), #icode{}) -> 'ok'. +%% @doc Prettyprints linear Icode on IoDevice. +%%

Badly formed or unknown instructions are printed surrounded by +%% three stars "***".

+pp(Dev, Icode) -> + {Mod, Fun, Arity} = hipe_icode:icode_fun(Icode), + Args = hipe_icode:icode_params(Icode), + io:format(Dev, "~w:~w/~w(", [Mod, Fun, Arity]), + pp_args(Dev, Args), + io:format(Dev, ") ->~n", []), + io:format(Dev, "%% Info:~p\n", + [[case hipe_icode:icode_is_closure(Icode) of + true -> 'Closure'; + false -> 'Not a closure' + end, + case hipe_icode:icode_is_leaf(Icode) of + true -> 'Leaf function'; + false -> 'Not a leaf function' + end | + hipe_icode:icode_info(Icode)]]), + pp_instrs(Dev, hipe_icode:icode_code(Icode)), + io:format(Dev, "%% Data:\n", []), + hipe_data_pp:pp(Dev, hipe_icode:icode_data(Icode), icode, ""). + +-spec pp_block(icode_instrs()) -> 'ok'. +pp_block(Code) -> + pp_instrs(standard_io, Code). + +-spec pp_instrs(io:device(), icode_instrs()) -> 'ok'. +%% @doc Prettyprints a list of Icode instructions. +pp_instrs(Dev, Is) -> + lists:foreach(fun (I) -> pp_instr(Dev, I) end, Is). + +%%--------------------------------------------------------------------- + +pp_instr(Dev, I) -> + case I of + #icode_label{} -> + io:format(Dev, "~p:~n", [hipe_icode:label_name(I)]); + #icode_comment{} -> + Txt = hipe_icode:comment_text(I), + Str = case io_lib:deep_char_list(Txt) of + true -> Txt; + false -> io_lib:format("~p", [Txt]) + end, + io:format(Dev, " % ~s~n", [Str]); + #icode_phi{} -> + io:format(Dev, " ", []), + pp_arg(Dev, hipe_icode:phi_dst(I)), + io:format(Dev, " := phi(", []), + pp_phi_args(Dev, hipe_icode:phi_arglist(I)), + io:format(Dev, ")~n", []); + #icode_move{} -> + io:format(Dev, " ", []), + pp_arg(Dev, hipe_icode:move_dst(I)), + io:format(Dev, " := ", []), + pp_arg(Dev, hipe_icode:move_src(I)), + io:format(Dev, "~n", []); + #icode_call{} -> + io:format(Dev, " ", []), + case hipe_icode:call_dstlist(I) of + [] -> %% result is unused -- e.g. taken out by dead code elimination + io:format(Dev, "_ := ", []); + DstList -> + pp_args(Dev, DstList), + io:format(Dev, " := ", []) + end, + pp_fun(Dev, hipe_icode:call_fun(I), + hipe_icode:call_args(I), + hipe_icode:call_type(I), + hipe_icode:call_in_guard(I)), + case hipe_icode:call_continuation(I) of + [] -> + ok; + CC -> + io:format(Dev, " -> ~w", [CC]) + end, + case hipe_icode:call_fail_label(I) of + [] -> io:format(Dev, "~n", []); + Fail -> io:format(Dev, ", #fail ~w~n", [Fail]) + end; + #icode_enter{} -> + io:format(Dev, " ", []), + pp_fun(Dev, hipe_icode:enter_fun(I), + hipe_icode:enter_args(I), + hipe_icode:enter_type(I)), + io:format(Dev, "~n", []); + #icode_return{} -> + io:format(Dev, " return(", []), + pp_args(Dev, hipe_icode:return_vars(I)), + io:format(Dev, ")~n", []); + #icode_begin_try{} -> + io:format(Dev, " begin_try -> ~w cont ~w~n", + [hipe_icode:begin_try_label(I), + hipe_icode:begin_try_successor(I)]); + #icode_begin_handler{} -> + io:format(Dev, " ", []), + pp_args(Dev, hipe_icode:begin_handler_dstlist(I)), + io:format(Dev, " := begin_handler()~n",[]); + #icode_end_try{} -> + io:format(Dev, " end_try~n", []); + #icode_fail{} -> + Type = hipe_icode:fail_class(I), + io:format(Dev, " fail(~w, [", [Type]), + pp_args(Dev, hipe_icode:fail_args(I)), + case hipe_icode:fail_label(I) of + [] -> io:put_chars(Dev, "])\n"); + Fail -> io:format(Dev, "]) -> ~w\n", [Fail]) + end; + #icode_if{} -> + io:format(Dev, " if ~w(", [hipe_icode:if_op(I)]), + pp_args(Dev, hipe_icode:if_args(I)), + io:format(Dev, ") then ~p (~.2f) else ~p~n", + [hipe_icode:if_true_label(I), hipe_icode:if_pred(I), + hipe_icode:if_false_label(I)]); + #icode_switch_val{} -> + io:format(Dev, " switch_val ",[]), + pp_arg(Dev, hipe_icode:switch_val_term(I)), + pp_switch_cases(Dev, hipe_icode:switch_val_cases(I)), + io:format(Dev, " fail -> ~w\n", + [hipe_icode:switch_val_fail_label(I)]); + #icode_switch_tuple_arity{} -> + io:format(Dev, " switch_tuple_arity ",[]), + pp_arg(Dev, hipe_icode:switch_tuple_arity_term(I)), + pp_switch_cases(Dev,hipe_icode:switch_tuple_arity_cases(I)), + io:format(Dev, " fail -> ~w\n", + [hipe_icode:switch_tuple_arity_fail_label(I)]); + #icode_type{} -> + io:format(Dev, " if is_", []), + pp_type(Dev, hipe_icode:type_test(I)), + io:format(Dev, "(", []), + pp_args(Dev, hipe_icode:type_args(I)), + io:format(Dev, ") then ~p (~.2f) else ~p~n", + [hipe_icode:type_true_label(I), hipe_icode:type_pred(I), + hipe_icode:type_false_label(I)]); + #icode_goto{} -> + io:format(Dev, " goto ~p~n", [hipe_icode:goto_label(I)]) + end. + +pp_fun(Dev, Fun, Args, Type) -> + pp_fun(Dev, Fun, Args, Type, false). + +pp_fun(Dev, Fun, Args, Type, Guard) -> + case Type of + primop -> + hipe_icode_primops:pp(Dev, Fun); + local -> + {_,F,A} = Fun, + io:format(Dev, "~w/~w", [F, A]); + remote -> + {M,F,A} = Fun, + io:format(Dev, "~w:~w/~w", [M, F, A]) + end, + io:format(Dev, "(", []), + pp_args(Dev, Args), + case Guard of + true -> + case Type of + primop -> + io:format(Dev, ") (primop,guard)", []); + _ -> + io:format(Dev, ") (guard)", []) + end; + false -> + case Type of + primop -> + io:format(Dev, ") (primop)", []); + _ -> + io:format(Dev, ")", []) + end + end. + +pp_arg(Dev, Arg) -> + case hipe_icode:is_variable(Arg) of + true -> + case hipe_icode:is_var(Arg) of + true -> + N = hipe_icode:var_name(Arg), + io:format(Dev, "v~p", [N]); + false -> + case hipe_icode:is_reg(Arg) of + true -> + N = hipe_icode:reg_name(Arg), + io:format(Dev, "r~p", [N]); + false -> + N = hipe_icode:fvar_name(Arg), + io:format(Dev, "fv~p", [N]) + end + end, + case hipe_icode:is_annotated_variable(Arg) of + true -> + {_,Val,Fun} = hipe_icode:variable_annotation(Arg), + io:format(Dev, " (~s)", [Fun(Val)]); + false -> + ok + end; + false -> + Const = hipe_icode:const_value(Arg), + io:format(Dev, "~p", [Const]) % ~p because it also prints "" + end. + +pp_args(_Dev, []) -> ok; +pp_args(Dev, [A]) -> + pp_arg(Dev, A); +pp_args(Dev, [A|Args]) -> + pp_arg(Dev, A), + io:format(Dev, ", ", []), + pp_args(Dev, Args). + +pp_phi_args(_Dev, []) -> ok; +pp_phi_args(Dev, [{Pred,A}]) -> + io:format(Dev, "{~w, ", [Pred]), + pp_arg(Dev, A), + io:format(Dev, "}", []); +pp_phi_args(Dev, [{Pred,A}|Args]) -> + io:format(Dev, "{~w, ", [Pred]), + pp_arg(Dev, A), + io:format(Dev, "}, ", []), + pp_phi_args(Dev, Args). + +pp_type(Dev, T) -> + io:format(Dev, "~w", [T]). + +pp_switch_cases(Dev, Cases) -> + io:format(Dev, " of\n",[]), + pp_switch_cases(Dev, Cases,1), + io:format(Dev, "",[]). + +pp_switch_cases(Dev, [{Val,L}], _Pos) -> + io:format(Dev, " ",[]), + pp_arg(Dev, Val), + io:format(Dev, " -> ~w\n", [L]); +pp_switch_cases(Dev, [{Val, L}|Ls], Pos) -> + io:format(Dev, " ",[]), + pp_arg(Dev, Val), + io:format(Dev, " -> ~w;\n", [L]), + NewPos = Pos, + %% case Pos of + %% 5 -> io:format(Dev, "\n ",[]), + %% 0; + %% N -> N + 1 + %% end, + pp_switch_cases(Dev, Ls, NewPos); +pp_switch_cases(_Dev, [], _) -> ok. + diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl new file mode 100644 index 0000000000..b0fe7eb708 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -0,0 +1,963 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Copyright (c) 2001 by Erik Johansson. All Rights Reserved +%% ==================================================================== +%% Filename : hipe_icode_primops.erl +%% Module : hipe_icode_primops +%% Purpose : +%% Notes : +%% History : * 2001-06-13 Erik Johansson (happi@it.uu.se): +%% Created. +%% +%% $Id$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hipe_icode_primops). + +-export([is_safe/1, fails/1, pp/2, type/1, type/2, arg_types/1]). + +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). + +%%--------------------------------------------------------------------- + +%% Note that 'unsafe_...' operations are generally "safe", i.e., it is +%% typically unsafe to use them unless you have extra information about +%% the call (e.g., if the types are known). However, if they have been +%% correctly introduced in the code, most of them are also OK to remove +%% if the result is not used. + +-spec is_safe(icode_primop()) -> boolean(). + +is_safe('+') -> false; +is_safe('/') -> false; +is_safe('*') -> false; +is_safe('-') -> false; +is_safe('bsr') -> false; +is_safe('bsl') -> false; +is_safe('band') -> false; +is_safe('bor') -> false; +is_safe('bxor') -> false; +is_safe('bnot') -> false; +is_safe('div') -> false; +is_safe('rem') -> false; +is_safe(call_fun) -> false; +is_safe(check_get_msg) -> false; +is_safe(clear_timeout) -> false; +is_safe(cons) -> true; +%% is_safe(conv_to_float) -> false; +is_safe(extra_unsafe_add) -> true; +is_safe(extra_unsafe_sub) -> true; +is_safe(fcheckerror) -> false; +is_safe(fclearerror) -> false; +is_safe(fp_add) -> false; +is_safe(fp_div) -> false; +is_safe(fp_mul) -> false; +is_safe(fp_sub) -> false; +is_safe(mktuple) -> true; +is_safe(next_msg) -> false; +is_safe(redtest) -> false; +is_safe(select_msg) -> false; +is_safe(self) -> true; +is_safe(set_timeout) -> false; +is_safe(suspend_msg) -> false; +is_safe(unsafe_add) -> true; +is_safe(unsafe_band) -> true; +is_safe(unsafe_bnot) -> true; +is_safe(unsafe_bor) -> true; +is_safe(unsafe_bsl) -> true; +is_safe(unsafe_bsr) -> true; +is_safe(unsafe_bxor) -> true; +is_safe(unsafe_hd) -> true; +is_safe(unsafe_sub) -> true; +is_safe(unsafe_tag_float) -> true; +is_safe(unsafe_tl) -> true; +is_safe(unsafe_untag_float) -> true; +is_safe(#apply_N{}) -> false; +is_safe(#closure_element{}) -> true; +is_safe(#element{}) -> false; +%% is_safe(#gc_test{}) -> ??? +is_safe({hipe_bs_primop, {bs_start_match, _}}) -> false; +is_safe({hipe_bs_primop, {{bs_start_match, bitstr}, _}}) -> true; +is_safe({hipe_bs_primop, {{bs_start_match, ok_matchstate}, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_binary, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_binary_all, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_binary_all_2, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_integer, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_float, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_skip_bits, _}}) -> false; +is_safe({hipe_bs_primop, {bs_skip_bits_all, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_test_tail, _}}) -> false; +is_safe({hipe_bs_primop, {bs_restore, _}}) -> true; +is_safe({hipe_bs_primop, {bs_save, _}}) -> true; +is_safe({hipe_bs_primop, {bs_add, _}}) -> false; +is_safe({hipe_bs_primop, {bs_add, _, _}}) -> false; +is_safe({hipe_bs_primop, bs_bits_to_bytes}) -> false; +is_safe({hipe_bs_primop, bs_bits_to_bytes2}) -> false; +is_safe({hipe_bs_primop, {bs_init, _}}) -> false; +is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; +is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; +is_safe({hipe_bs_primop, bs_put_utf8}) -> false; +is_safe({hipe_bs_primop, bs_utf8_size}) -> true; +is_safe({hipe_bs_primop, bs_get_utf8}) -> false; +is_safe({hipe_bs_primop, bs_utf16_size}) -> true; +is_safe({hipe_bs_primop, {bs_put_utf16, _}}) -> false; +is_safe({hipe_bs_primop, {bs_get_utf16, _}}) -> false; +is_safe({hipe_bs_primop, bs_validate_unicode}) -> false; +is_safe({hipe_bs_primop, bs_validate_unicode_retract}) -> false; +is_safe({hipe_bs_primop, {unsafe_bs_put_integer, _, _, _}}) -> false; +is_safe({hipe_bs_primop, bs_final}) -> true; +is_safe({hipe_bs_primop, bs_context_to_binary}) -> true; +is_safe({hipe_bs_primop, {bs_test_unit, _}}) -> false; +is_safe({hipe_bs_primop, {bs_match_string, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_append, _, _, _, _}}) -> false; +is_safe({hipe_bs_primop, {bs_private_append, _, _}}) -> false; +is_safe({hipe_bs_primop, bs_init_writable}) -> true; +is_safe(#mkfun{}) -> true; +is_safe(#unsafe_element{}) -> true; +is_safe(#unsafe_update_element{}) -> true. + + +-spec fails(icode_funcall()) -> boolean(). + +fails('+') -> true; +fails('-') -> true; +fails('*') -> true; +fails('/') -> true; +fails('bnot') -> true; +fails('band') -> true; +fails('bor') -> true; +fails('bsl') -> true; +fails('bsr') -> true; +fails('bxor') -> true; +fails('div') -> true; +fails('rem') -> true; +fails(call_fun) -> true; +fails(check_get_msg) -> true; +fails(clear_timeout) -> false; +fails(cons) -> false; +fails(conv_to_float) -> true; +fails(extra_unsafe_add) -> false; +fails(extra_unsafe_sub) -> false; +fails(fcheckerror) -> true; +fails(fclearerror) -> false; +fails(fp_add) -> false; +fails(fp_div) -> false; +fails(fp_mul) -> false; +fails(fp_sub) -> false; +fails(mktuple) -> false; +fails(next_msg) -> false; +fails(redtest) -> false; +fails(select_msg) -> false; +fails(self) -> false; +fails(set_timeout) -> true; +fails(suspend_msg) -> false; +fails(unsafe_untag_float) -> false; +fails(unsafe_tag_float) -> false; +fails(unsafe_add) -> false; +fails(unsafe_band) -> false; +fails(unsafe_bnot) -> false; +fails(unsafe_bor) -> false; +fails(unsafe_bsl) -> false; +fails(unsafe_bsr) -> false; +fails(unsafe_bxor) -> false; +fails(unsafe_hd) -> false; +fails(unsafe_sub) -> false; +%% fails(unsafe_tag_float) -> false; +fails(unsafe_tl) -> false; +%% fails(unsafe_untag_float) -> false; +fails(#apply_N{}) -> true; +fails(#closure_element{}) -> false; +fails(#element{}) -> true; +%% fails(#gc_test{}) -> ??? +fails({hipe_bs_primop, {bs_start_match, _}}) -> true; +fails({hipe_bs_primop, {{bs_start_match, bitstr}, _}}) -> true; +fails({hipe_bs_primop, {{bs_start_match, ok_matchstate}, _}}) -> false; +fails({hipe_bs_primop, {bs_get_binary, _, _}}) -> true; +fails({hipe_bs_primop, {bs_get_binary_all, _, _}}) -> true; +fails({hipe_bs_primop, {bs_get_binary_all_2, _, _}}) -> true; +fails({hipe_bs_primop, {bs_get_integer, _, _}}) -> true; +fails({hipe_bs_primop, {bs_get_float, _, _}}) -> true; +fails({hipe_bs_primop, {bs_skip_bits, _}}) -> true; +fails({hipe_bs_primop, {bs_skip_bits_all, _, _}}) -> true; +fails({hipe_bs_primop, {bs_test_tail, _}}) -> true; +fails({hipe_bs_primop, {bs_restore, _}}) -> false; +fails({hipe_bs_primop, {bs_save, _}}) -> false; +fails({hipe_bs_primop, bs_context_to_binary}) -> false; +fails({hipe_bs_primop, {bs_test_unit, _}}) -> true; +fails({hipe_bs_primop, {bs_match_string, _, _}}) -> true; +fails({hipe_bs_primop, {bs_add, _}}) -> true; +fails({hipe_bs_primop, {bs_add, _, _}}) -> true; +fails({hipe_bs_primop, bs_bits_to_bytes}) -> true; +fails({hipe_bs_primop, bs_bits_to_bytes2}) -> true; +fails({hipe_bs_primop, {bs_init, _}}) -> true; +fails({hipe_bs_primop, {bs_init, _, _}}) -> true; +fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; +fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; +fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; +fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; +fails({hipe_bs_primop, bs_put_utf8}) -> true; +fails({hipe_bs_primop, bs_utf8_size}) -> false; +fails({hipe_bs_primop, bs_get_utf8}) -> true; +fails({hipe_bs_primop, bs_utf16_size}) -> false; +fails({hipe_bs_primop, {bs_put_utf16, _}}) -> true; +fails({hipe_bs_primop, {bs_get_utf16, _}}) -> true; +fails({hipe_bs_primop, bs_validate_unicode}) -> true; +fails({hipe_bs_primop, bs_validate_unicode_retract}) -> true; +fails({hipe_bs_primop, {unsafe_bs_put_integer, _, _, _}}) -> true; +fails({hipe_bs_primop, bs_final}) -> false; +fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true; +fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true; +fails({hipe_bs_primop, bs_init_writable}) -> true; +fails(#mkfun{}) -> false; +fails(#unsafe_element{}) -> false; +fails(#unsafe_update_element{}) -> false; +%% Apparently, we are calling fails/1 for all MFAs which are compiled. +%% This is weird and we should restructure the compiler to avoid +%% calling fails/1 for things that are not primops. +fails({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> + %% Yes, we should move this. + not erl_bifs:is_safe(M, F, A). + +%%===================================================================== +%% Pretty printing +%%===================================================================== + +-spec pp(io:device(), icode_primop()) -> 'ok'. + +pp(Dev, Op) -> + case Op of + #apply_N{arity = N} -> + io:format(Dev, "apply_N<~w>/", [N]); + #closure_element{n = N} -> + io:format(Dev, "closure_element<~w>", [N]); + #element{} -> + io:format(Dev, "element", []); + #gc_test{need = N} -> + io:format(Dev, "gc_test<~w>", [N]); + {hipe_bs_primop, BsOp} -> + case BsOp of + {bs_put_binary_all, Flags} -> + io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary, Size} -> + io:format(Dev, "bs_put_binary<~w>", [Size]); + {bs_put_binary, Flags, Size} -> + io:format(Dev, "bs_put_binary<~w, ~w>", [Flags, Size]); + {bs_put_float, Flags, Size, _ConstInfo} -> + io:format(Dev, "bs_put_float<~w, ~w>", [Flags, Size]); + {bs_put_string, String, SizeInBytes} -> + io:format(Dev, "bs_put_string<~w, ~w>", [String, SizeInBytes]); + {bs_put_integer, Bits, Flags, _ConstInfo} -> + io:format(Dev, "bs_put_integer<~w, ~w>", [Bits, Flags]); + {unsafe_bs_put_integer, Bits, Flags, _ConstInfo} -> + io:format(Dev, "unsafe_bs_put_integer<~w, ~w>", [Bits, Flags]); + {bs_skip_bits_all, Unit, Flags} -> + io:format(Dev, "bs_skip_bits_all<~w,~w>", [Unit, Flags]); + {bs_skip_bits, Unit} -> + io:format(Dev, "bs_skip_bits<~w>", [Unit]); + {bs_start_match, Max} -> + io:format(Dev, "bs_start_match<~w>", [Max]); + {{bs_start_match, Type}, Max} -> + io:format(Dev, "bs_start_match<~w,~w>", [Type,Max]); + {bs_match_string, String, SizeInBytes} -> + io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBytes]); + {bs_get_integer, Size, Flags} -> + io:format(Dev, "bs_get_integer<~w, ~w>", [Size, Flags]); + {bs_get_float, Size, Flags} -> + io:format(Dev, "bs_get_float<~w, ~w>", [Size, Flags]); + {bs_get_binary, Size, Flags} -> + io:format(Dev, "bs_get_binary<~w, ~w>", [Size, Flags]); + {bs_get_binary_all, Unit, Flags} -> + io:format(Dev, "bs_get_binary_all<~w,~w>", [Unit, Flags]); + {bs_get_binary_all_2, Unit, Flags} -> + io:format(Dev, "bs_get_binary_all<~w,~w>", [Unit, Flags]); + {bs_test_tail, NumBits} -> + io:format(Dev, "bs_test_tail<~w>", [NumBits]); + {bs_test_unit, Unit} -> + io:format(Dev, "bs_test_unit<~w>", [Unit]); + bs_context_to_binary -> + io:format(Dev, "bs_context_to_binary", []); + {bs_restore, Index} -> + io:format(Dev, "bs_restore<~w>", [Index]); + {bs_save, Index} -> + io:format(Dev, "bs_save<~w>", [Index]); + {bs_init, Size, Flags} -> + io:format(Dev, "bs_init<~w, ~w>", [Size, Flags]); + {bs_init,Flags} -> + io:format(Dev, "bs_init<~w>", [Flags]); + {bs_init_bits, Size, Flags} -> + io:format(Dev, "bs_init_bits<~w, ~w>", [Size, Flags]); + {bs_init_bits, Flags} -> + io:format(Dev, "bs_init_bits<~w>", [Flags]); + {bs_add, Unit} -> + io:format(Dev, "bs_add<~w>", [Unit]); + {bs_add, Const, Unit} -> + io:format(Dev, "bs_add<~w, ~w>", [Const, Unit]); + {bs_append, X, Y, Z, W} -> + io:format(Dev, "bs_append<~w, ~w, ~w, ~w>", [X, Y, Z, W]); + {bs_private_append, U, Flags} -> + io:format(Dev, "bs_private_append<~w, ~w>", [U, Flags]); + bs_bits_to_bytes -> + io:format(Dev, "bs_bits_to_bytes", []); + bs_bits_to_bytes2 -> + io:format(Dev, "bs_bits_to_bytes2", []); + bs_utf8_size -> + io:format(Dev, "bs_utf8_size", []); + bs_put_utf8 -> + io:format(Dev, "bs_put_utf8", []); + bs_get_utf8 -> + io:format(Dev, "bs_get_utf8", []); + bs_utf16_size -> + io:format(Dev, "bs_utf16_size", []); + {bs_put_utf16, Flags} -> + io:format(Dev, "bs_put_utf16<~w>", [Flags]); + {bs_get_utf16, Flags} -> + io:format(Dev, "bs_get_utf16<~w>", [Flags]); + bs_validate_unicode -> + io:format(Dev, "bs_validate_unicode", []); + bs_validate_unicode_retract -> + io:format(Dev, "bs_validate_unicode_retract", []); + bs_final -> + io:format(Dev, "bs_final", []); + bs_final2 -> + io:format(Dev, "bs_final2", []); + bs_init_writable -> + io:format(Dev, "bs_init_writable", []) + end; + #mkfun{mfa = {Mod, Fun, Arity}, magic_num = Unique, index = I} -> + io:format(Dev, "mkfun<~w,~w,~w,~w,~w>", [Mod, Fun, Arity, Unique, I]); + #unsafe_element{index = N} -> + io:format(Dev, "unsafe_element<~w>", [N]); + #unsafe_update_element{index = N} -> + io:format(Dev, "unsafe_update_element<~w>", [N]); + Fun when is_atom(Fun) -> + io:format(Dev, "~w", [Fun]) + end. + +%%===================================================================== +%% Type handling +%%===================================================================== + +-spec type(icode_funcall(), [erl_types:erl_type()]) -> erl_types:erl_type(). + +type(Primop, Args) -> + case Primop of +%%% ----------------------------------------------------- +%%% Arithops + '+' -> + erl_bif_types:type(erlang, '+', 2, Args); + '-' -> + erl_bif_types:type(erlang, '-', 2, Args); + '*' -> + erl_bif_types:type(erlang, '*', 2, Args); + '/' -> + erl_bif_types:type(erlang, '/', 2, Args); + 'band' -> + erl_bif_types:type(erlang, 'band', 2, Args); + 'bnot' -> + erl_bif_types:type(erlang, 'bnot', 1, Args); + 'bor' -> + erl_bif_types:type(erlang, 'bor', 2, Args); + 'bxor' -> + erl_bif_types:type(erlang, 'bxor', 2, Args); + 'bsl' -> + erl_bif_types:type(erlang, 'bsl', 2, Args); + 'bsr' -> + erl_bif_types:type(erlang, 'bsr', 2, Args); + 'div' -> + erl_bif_types:type(erlang, 'div', 2, Args); + 'rem' -> + erl_bif_types:type(erlang, 'rem', 2, Args); + extra_unsafe_add -> + erl_bif_types:type(erlang, '+', 2, Args); + unsafe_add -> + erl_bif_types:type(erlang, '+', 2, Args); + unsafe_bnot -> + erl_bif_types:type(erlang, 'bnot', 1, Args); + unsafe_bor -> + erl_bif_types:type(erlang, 'bor', 2, Args); + unsafe_band -> + erl_bif_types:type(erlang, 'band', 2, Args); + unsafe_bxor -> + erl_bif_types:type(erlang, 'bxor', 2, Args); + unsafe_sub -> + erl_bif_types:type(erlang, '-', 2, Args); +%%% ----------------------------------------------------- +%%% Lists + cons -> + [HeadType, TailType] = Args, + erl_types:t_cons(HeadType, TailType); + unsafe_hd -> + [Type] = Args, + case erl_types:t_is_cons(Type) of + true -> erl_types:t_cons_hd(Type); + false -> erl_types:t_none() + end; + unsafe_tl -> + [Type] = Args, + case erl_types:t_is_cons(Type) of + true -> erl_types:t_cons_tl(Type); + false -> erl_types:t_none() + end; +%%% ----------------------------------------------------- +%%% Tuples + mktuple -> + erl_types:t_tuple(Args); + #element{} -> + erl_bif_types:type(erlang, element, 2, Args); + #unsafe_element{index = N} -> + [Type] = Args, + case erl_types:t_is_tuple(Type) of + false -> + erl_types:t_none(); + true -> + Index = erl_types:t_from_term(N), + erl_bif_types:type(erlang, element, 2, [Index|Args]) + end; + #unsafe_update_element{index = N} -> + %% Same, same + erl_bif_types:type(erlang, setelement, 3, [erl_types:t_integer(N)|Args]); +%%% ----------------------------------------------------- +%%% Floats + fclearerror -> + erl_types:t_any(); + fcheckerror -> + erl_types:t_any(); + unsafe_tag_float -> + erl_types:t_float(); + %% These might look surprising, but the return is an untagged + %% float and we have no type for untagged values. + conv_to_float -> + erl_types:t_any(); + unsafe_untag_float -> + erl_types:t_any(); + fp_add -> + erl_types:t_any(); + fp_sub -> + erl_types:t_any(); + fp_mul -> + erl_types:t_any(); + fp_div -> + erl_types:t_any(); + fnegate -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% + {hipe_bs_primop, {bs_start_match, Max}} -> + [Type] = Args, + Init = + erl_types:t_sup( + erl_types:t_matchstate_present(Type), + erl_types:t_inf(erl_types:t_bitstr(1, 0), Type)), + case erl_types:t_is_none(Init) of + true -> + erl_types:t_none(); + false -> + erl_types:t_matchstate(Init, Max) + end; + {hipe_bs_primop, {{bs_start_match, _}, Max}} -> + [Type] = Args, + Init = + erl_types:t_sup( + erl_types:t_matchstate_present(Type), + erl_types:t_inf(erl_types:t_bitstr(1, 0), Type)), + case erl_types:t_is_none(Init) of + true -> + erl_types:t_none(); + false -> + erl_types:t_matchstate(Init, Max) + end; + {hipe_bs_primop, {bs_get_integer, Size, Flags}} -> + Signed = Flags band 4, + [MatchState|RestArgs] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + case RestArgs of + [] -> + NewBinType = match_bin(erl_types:t_bitstr(0, Size), BinType), + NewMatchState = + erl_types:t_matchstate_update_present(NewBinType, MatchState), + if Signed =:= 0 -> + erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), + NewMatchState]); + Signed =:= 4 -> + erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), + (1 bsl (Size-1)) - 1), + NewMatchState]) + end; + [_Arg] -> + NewBinType = match_bin(erl_types:t_bitstr(Size, 0), BinType), + NewMatchState = + erl_types:t_matchstate_update_present(NewBinType, MatchState), + erl_types:t_product([erl_types:t_integer(), NewMatchState]) + end; + {hipe_bs_primop, {bs_get_float, Size, _Flags}} -> + [MatchState|RestArgs] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + NewBinType = + case RestArgs of + [] -> + match_bin(erl_types:t_bitstr(0,Size),BinType); + [_Arg] -> + erl_types:t_sup(match_bin(erl_types:t_bitstr(0, 32), BinType), + match_bin(erl_types:t_bitstr(0, 64), BinType)) + end, + NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), + erl_types:t_product([erl_types:t_float(), NewMatchState]); + {hipe_bs_primop, {bs_get_binary, Size, _Flags}} -> + [MatchState|RestArgs] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + case RestArgs of + [] -> + NewBinType = match_bin(erl_types:t_bitstr(0, Size), BinType), + NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), + erl_types:t_product([erl_types:t_bitstr(0,Size), NewMatchState]); + [ArgType] -> + Posint = erl_types:t_inf(erl_types:t_non_neg_integer(), ArgType), + case erl_types:t_is_none(Posint) of + true -> + erl_types:t_product([erl_types:t_none(), + erl_types:t_matchstate_update_present( + erl_types:t_none(), + MatchState)]); + false -> + OutBinType = + erl_types:t_bitstr(Size,erl_types:number_min(Posint)*Size), + NewBinType = match_bin(OutBinType,BinType), + NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), + erl_types:t_product([OutBinType, NewMatchState]) + end + end; + {hipe_bs_primop, {bs_get_binary_all, Unit, _Flags}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + erl_types:t_inf(BinType, erl_types:t_bitstr(Unit, 0)); + {hipe_bs_primop, {bs_get_binary_all_2, Unit, _Flags}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + erl_types:t_product( + [erl_types:t_inf(BinType,erl_types:t_bitstr(Unit, 0)), + erl_types:t_matchstate_update_present( + erl_types:t_bitstr(0, 0), MatchState)]); + {hipe_bs_primop, {bs_skip_bits_all, _Unit, _Flags}} -> + [MatchState] = Args, + erl_types:t_matchstate_update_present(erl_types:t_bitstr(0,0),MatchState); + {hipe_bs_primop, {bs_skip_bits, Size}} -> + [MatchState|RestArgs] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + NewBinType = + case RestArgs of + [] -> + match_bin(erl_types:t_bitstr(0, Size), BinType); + [_Arg] -> + match_bin(erl_types:t_bitstr(Size, 0), BinType) + end, + erl_types:t_matchstate_update_present(NewBinType, MatchState); + {hipe_bs_primop, {bs_save, Slot}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + erl_types:t_matchstate_update_slot(BinType, MatchState, Slot); + {hipe_bs_primop, {bs_restore, Slot}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_slot(MatchState, Slot), + erl_types:t_matchstate_update_present(BinType, MatchState); + {hipe_bs_primop, bs_context_to_binary} -> + [Type] = Args, + erl_types:t_sup( + erl_types:t_subtract(Type, erl_types:t_matchstate()), + erl_types:t_matchstate_slot( + erl_types:t_inf(Type, erl_types:t_matchstate()), 0)); + {hipe_bs_primop, {bs_match_string,_,Bytes}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + NewBinType = match_bin(erl_types:t_bitstr(0, Bytes*8), BinType), + erl_types:t_matchstate_update_present(NewBinType, MatchState); + {hipe_bs_primop, {bs_test_unit,Unit}} -> + [MatchState] = Args, + BinType = erl_types:t_matchstate_present(MatchState), + NewBinType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), BinType), + erl_types:t_matchstate_update_present(NewBinType, MatchState); + {hipe_bs_primop, {bs_add, _, _}} -> + erl_types:t_integer(); + {hipe_bs_primop, {bs_add, _}} -> + erl_types:t_integer(); + {hipe_bs_primop, bs_bits_to_bytes} -> + erl_types:t_integer(); + {hipe_bs_primop, bs_bits_to_bytes2} -> + erl_types:t_integer(); + {hipe_bs_primop, {Name, Size, _Flags, _ConstInfo}} + when Name =:= bs_put_integer; + Name =:= bs_put_float -> + case Args of + [_SrcType, _Base, Type] -> + erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, Size)); + [_SrcType,_BitsType, _Base, Type] -> + erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) + end; + {hipe_bs_primop, {bs_put_binary, Size, _Flags}} -> + case Args of + [_SrcType, _Base, Type] -> + erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, Size)); + [_SrcType, _BitsType, _Base, Type] -> + erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) + end; + {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> + [SrcType, _Base, Type] = Args, + erl_types:t_bitstr_concat(SrcType,Type); + {hipe_bs_primop, {bs_put_string, _, Size}} -> + [_Base, Type] = Args, + erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(0, 8*Size)); + {hipe_bs_primop, bs_utf8_size} -> + [_Arg] = Args, + erl_types:t_from_range(1, 4); + {hipe_bs_primop, bs_utf16_size} -> + [_Arg] = Args, + erl_types:t_from_range(2, 4); % XXX: really 2 | 4 + {hipe_bs_primop, bs_final} -> + [_Base, Type] = Args, + Type; + {hipe_bs_primop, {bs_init, Size, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(0, Size*8), + erl_types:t_any(), + erl_types:t_bitstr(0, 0)]); + {hipe_bs_primop, {bs_init, _Flags}} -> + erl_types:t_product( + [erl_types:t_binary(), + erl_types:t_any(), + erl_types:t_bitstr(0, 0)]); + {hipe_bs_primop, {bs_init_bits, Size, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(0, Size), + erl_types:t_any(), + erl_types:t_bitstr(0, 0)]); + {hipe_bs_primop, {bs_init_bits, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(), + erl_types:t_any(), + erl_types:t_bitstr(0, 0)]); + {hipe_bs_primop, {bs_private_append, _U, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(), + erl_types:t_any(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_append, _W, _R, _U, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(), + erl_types:t_any(), + erl_types:t_bitstr()]); + {hipe_bs_primop, bs_init_writable} -> + erl_types:t_bitstr(0, 0); + {hipe_bs_primop, _BsOp} -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Funs + #mkfun{mfa = {_M, _F, A}} -> + %% Note that the arity includes the bound variables in args + erl_types:t_fun(A - length(Args), erl_types:t_any()); + #apply_N{} -> + erl_types:t_any(); + Op when Op =:= call_fun orelse Op =:= enter_fun -> + [Fun0|TailArgs0] = lists:reverse(Args), + TailArgs = lists:reverse(TailArgs0), + Fun = erl_types:t_inf(erl_types:t_fun(), Fun0), + case erl_types:t_is_fun(Fun) of + true -> + case erl_types:t_fun_args(Fun) of + unknown -> + erl_types:t_any(); + FunArgs -> + case check_fun_args(FunArgs, TailArgs) of + ok -> + erl_types:t_fun_range(Fun); + error -> + erl_types:t_none() + end + end; + false -> + erl_types:t_none() + end; +%%% ----------------------------------------------------- +%%% Communication + check_get_msg -> + erl_types:t_any(); + clear_timeout -> + erl_types:t_any(); + next_msg -> + erl_types:t_any(); + select_msg -> + erl_types:t_any(); + set_timeout -> + erl_types:t_any(); + suspend_msg -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Other + #closure_element{} -> + erl_types:t_any(); + redtest -> + erl_types:t_any(); + {M, F, A} -> + erl_bif_types:type(M, F, A, Args) + end. + + +-spec type(icode_funcall()) -> erl_types:erl_type(). + +type(Primop) -> + case Primop of +%%% ----------------------------------------------------- +%%% Arithops + 'bnot' -> + erl_bif_types:type(erlang, 'bnot', 1); + '+' -> + erl_bif_types:type(erlang, '+', 2); + '-' -> + erl_bif_types:type(erlang, '-', 2); + '*' -> + erl_bif_types:type(erlang, '*', 2); + '/' -> + erl_bif_types:type(erlang, '/', 2); + 'div' -> + erl_bif_types:type(erlang, 'div', 2); + 'rem' -> + erl_bif_types:type(erlang, 'rem', 2); + 'band' -> + erl_bif_types:type(erlang, 'band', 2); + 'bor' -> + erl_bif_types:type(erlang, 'bor', 2); + 'bxor' -> + erl_bif_types:type(erlang, 'bxor', 2); + 'bsr' -> + erl_bif_types:type(erlang, 'bsr', 2); + 'bsl' -> + erl_bif_types:type(erlang, 'bsl', 2); + unsafe_add -> + erl_bif_types:type(erlang, '+', 2); + extra_unsafe_add -> + erl_bif_types:type(erlang, '+', 2); + unsafe_sub -> + erl_bif_types:type(erlang, '-', 2); + unsafe_bor -> + erl_bif_types:type(erlang, 'bor', 2); + unsafe_band -> + erl_bif_types:type(erlang, 'band', 2); + unsafe_bxor -> + erl_bif_types:type(erlang, 'bxor', 2); +%%% ----------------------------------------------------- +%%% Lists + cons -> + erl_types:t_cons(); + unsafe_hd -> + erl_bif_types:type(erlang, hd, 1); + unsafe_tl -> + erl_bif_types:type(erlang, tl, 1); +%%% ----------------------------------------------------- +%%% Tuples + mktuple -> + erl_types:t_tuple(); + #element{} -> + erl_bif_types:type(erlang, element, 2); + #unsafe_element{} -> + erl_bif_types:type(erlang, element, 2); + #unsafe_update_element{} -> + erl_bif_types:type(erlang, setelement, 3); +%%% ----------------------------------------------------- +%%% Floats + fclearerror -> + erl_types:t_any(); + fcheckerror -> + erl_types:t_any(); + unsafe_tag_float -> + erl_types:t_float(); + %% These might look surprising, but the return is an untagged + %% float and we have no type for untagged values. + conv_to_float -> + erl_types:t_any(); + unsafe_untag_float -> + erl_types:t_any(); + fp_add -> + erl_types:t_any(); + fp_sub -> + erl_types:t_any(); + fp_mul -> + erl_types:t_any(); + fp_div -> + erl_types:t_any(); + fnegate -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Binaries + {hipe_bs_primop, bs_get_utf8} -> + erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]); + {hipe_bs_primop, {bs_get_utf16, _Flags}} -> + erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]); + {hipe_bs_primop, {bs_get_integer, _Size, _Flags}} -> + erl_types:t_product([erl_types:t_integer(), erl_types:t_matchstate()]); + {hipe_bs_primop, {bs_get_float, _, _}} -> + erl_types:t_product([erl_types:t_float(), erl_types:t_matchstate()]); + {hipe_bs_primop, {bs_get_binary, _, _}} -> + erl_types:t_product([erl_types:t_bitstr(), erl_types:t_matchstate()]); + {hipe_bs_primop, {bs_get_binary_all, _, _}} -> + erl_types:t_bitstr(); + {hipe_bs_primop, {bs_get_binary_all_2, _, _}} -> + erl_types:t_product([erl_types:t_bitstr(), erl_types:t_matchstate()]); + {hipe_bs_primop, bs_final} -> + erl_types:t_bitstr(); + {hipe_bs_primop, {bs_init, _, _}} -> + erl_types:t_product([erl_types:t_binary(), erl_types:t_bitstr(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_init, _}} -> + erl_types:t_product([erl_types:t_binary(), erl_types:t_bitstr(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_init_bits, Size, _}} -> + erl_types:t_product([erl_types:t_bitstr(0, Size), erl_types:t_bitstr(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_init_bits, _}} -> + erl_types:t_product([erl_types:t_bitstr(), erl_types:t_bitstr(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_add, _, _}} -> + erl_types:t_integer(); + {hipe_bs_primop, {bs_add, _}} -> + erl_types:t_integer(); + {hipe_bs_primop, bs_bits_to_bytes} -> + erl_types:t_integer(); + {hipe_bs_primop, bs_bits_to_bytes2} -> + erl_types:t_integer(); + {hipe_bs_primop, {bs_private_append, _U, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(), + erl_types:t_any(), + erl_types:t_bitstr()]); + {hipe_bs_primop, {bs_append, _W, _R, _U, _Flags}} -> + erl_types:t_product( + [erl_types:t_bitstr(), + erl_types:t_any(), + erl_types:t_bitstr()]); + {hipe_bs_primop, bs_init_writable} -> + erl_types:t_bitstr(); + {hipe_bs_primop, _BsOp} -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Funs + #mkfun{} -> + %% Note that the arity includes the bound variables in args + erl_types:t_fun(); + #apply_N{} -> + erl_types:t_any(); + call_fun -> + erl_types:t_any(); + enter_fun -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Communication + check_get_msg -> + erl_types:t_any(); + clear_timeout -> + erl_types:t_any(); + next_msg -> + erl_types:t_any(); + select_msg -> + erl_types:t_any(); + set_timeout -> + erl_types:t_any(); + suspend_msg -> + erl_types:t_any(); +%%% ----------------------------------------------------- +%%% Other + #closure_element{} -> + erl_types:t_any(); + redtest -> + erl_types:t_any(); + {M, F, A} -> + erl_bif_types:type(M, F, A) + end. + + +%% ===================================================================== +%% @doc +%% function arg_types returns a list of the demanded argument types for +%% a bif to succeed. + +-spec arg_types(icode_funcall()) -> [erl_types:erl_type()] | 'unknown'. + +arg_types(Primop) -> + case Primop of + {M, F, A} -> + erl_bif_types:arg_types(M, F, A); + #element{} -> + [erl_types:t_pos_fixnum(), erl_types:t_tuple()]; + '+' -> + erl_bif_types:arg_types(erlang, '+', 2); + '-' -> + erl_bif_types:arg_types(erlang, '-', 2); + '*' -> + erl_bif_types:arg_types(erlang, '*', 2); + '/' -> + erl_bif_types:arg_types(erlang, '/', 2); + 'band' -> + erl_bif_types:arg_types(erlang, 'band', 2); + 'bnot' -> + erl_bif_types:arg_types(erlang, 'bnot', 1); + 'bor' -> + erl_bif_types:arg_types(erlang, 'bor', 2); + 'bxor' -> + erl_bif_types:arg_types(erlang, 'bxor', 2); + 'bsl' -> + erl_bif_types:arg_types(erlang, 'bsl', 2); + 'bsr' -> + erl_bif_types:arg_types(erlang, 'bsr', 2); + 'div' -> + erl_bif_types:arg_types(erlang, 'div', 2); + 'rem' -> + erl_bif_types:arg_types(erlang, 'rem', 2); + _ -> + unknown % safe approximation for all primops. + end. + +%%===================================================================== +%% Auxiliary functions +%%===================================================================== + +check_fun_args([T1|Left1], [T2|Left2]) -> + Inf = erl_types:t_inf(T1, T2), + case erl_types:t_inf(Inf, T2) of + Inf -> + check_fun_args(Left1, Left2); + _ -> + error + end; +check_fun_args([], []) -> + ok; +check_fun_args(_, _) -> + error. + +match_bin(Pattern, Match) -> + erl_types:t_bitstr_match(Pattern, Match). diff --git a/lib/hipe/icode/hipe_icode_primops.hrl b/lib/hipe/icode/hipe_icode_primops.hrl new file mode 100644 index 0000000000..8a65c5ece0 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_primops.hrl @@ -0,0 +1,40 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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_icode_primops.hrl +%% Author : Kostis Sagonas +%% Description : Contains definitions for HiPE's primitive operations. +%%======================================================================= +%% $Id$ +%%======================================================================= + +-record(apply_N, {arity :: arity()}). + +-record(closure_element, {n :: arity()}). + +-record(element, {typeinfo :: list()}). %% XXX: refine? + +-record(gc_test, {need :: non_neg_integer()}). + +-record(mkfun, {mfa :: mfa(), magic_num :: integer(), index :: integer()}). + +-record(unsafe_element, {index :: non_neg_integer()}). + +-record(unsafe_update_element, {index :: non_neg_integer()}). diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl new file mode 100644 index 0000000000..bcc857acf4 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -0,0 +1,1966 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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_icode_range.erl +%%% Author : Per Gustafsson +%%% Description : +%%% +%%% Created : 12 Mar 2007 by Per Gustafsson +%%%------------------------------------------------------------------- +-module(hipe_icode_range). + +-export([cfg/4]). + +%%===================================================================== +%% Icode Coordinator Behaviour Callbacks +%%===================================================================== + +-export([replace_nones/1, + update__info/2, new__info/1, return__info/1, + return_none/0, return_none_args/2, return_any_args/2]). + +%%===================================================================== + +-import(erl_types, [t_any/0, + t_from_range_unsafe/2, + t_inf/2, t_integer/0, + t_to_string/1, t_to_tlist/1, + t_limit/2, t_none/0, + number_min/1, number_max/1]). + +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). +-include("../main/hipe.hrl"). +-include("../flow/cfg.hrl"). +-include("../flow/hipe_bb.hrl"). +-include("hipe_icode_type.hrl"). + +-type range_tuple() :: {'neg_inf' | integer(), 'pos_inf' | integer()}. +-type range_rep() :: range_tuple() | 'empty'. +-type fun_name() :: atom() | tuple(). +-type inf_integer() :: 'neg_inf' | 'pos_inf' | integer(). + +-record(range, {range :: range_rep(), + other :: boolean()}). + +-record(ann, {range :: #range{}, + type :: erl_types:erl_type(), + count :: integer()}). + +-type range_anno() :: {range_anno, #ann{}, fun((#ann{}) -> string())}. +-type args_fun() :: fun((mfa(),cfg()) -> [#range{}]). +-type call_fun() :: fun((mfa(),[#range{}]) -> #range{}). +-type final_fun() :: fun((mfa(),[#range{}]) -> ok). +-type data() :: {mfa(), args_fun(), call_fun(), final_fun()}. +-type label() :: non_neg_integer(). +-type info() :: gb_tree(). +-type work_list() :: {[label()], [label()], set()}. +-type variable() :: #icode_variable{}. +-type annotated_variable() :: #icode_variable{}. +-type argument() :: #icode_const{} | variable(). +-type three_range_fun() :: fun((#range{},#range{},#range{}) -> #range{}). +-type instr_split_info() :: {icode_instr(), [{label(),info()}]}. +-type last_instr_return() :: {instr_split_info(), #range{}}. + +-record(state, {info_map = gb_trees:empty() :: info(), + counter = dict:new() :: dict(), + cfg :: cfg(), + liveness = gb_trees:empty() :: gb_tree(), + ret_type :: #range{}, + lookup_fun :: call_fun(), + result_action :: final_fun()}). + +-define(WIDEN, 1). + +-define(TAG_IMMED1_SIZE, 4). + +-define(BITS, 64). + +%%--------------------------------------------------------------------- + +-spec cfg(cfg(), mfa(), comp_options(), #comp_servers{}) -> cfg(). + +cfg(Cfg, MFA, Options, Servers) -> + case proplists:get_bool(concurrent_comp, Options) of + true -> + concurrent_cfg(Cfg, MFA, Servers#comp_servers.range); + false -> + ordinary_cfg(Cfg, MFA) + end. + +-spec concurrent_cfg(cfg(), mfa(), pid()) -> cfg(). + +concurrent_cfg(Cfg, MFA, CompServer) -> + CompServer ! {ready, {MFA,self()}}, + {ArgsFun,CallFun,FinalFun} = do_analysis(Cfg, MFA), + Ans = do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun), + CompServer ! {done_rewrite, MFA}, + Ans. + +-spec do_analysis(cfg(), mfa()) -> {args_fun(), call_fun(), final_fun()}. + +do_analysis(Cfg, MFA) -> + receive + {analyse, {ArgsFun, CallFun, FinalFun}} -> + analyse(Cfg, {MFA, ArgsFun, CallFun, FinalFun}), + do_analysis(Cfg, MFA); + {done, {_NewArgsFun, _NewCallFun, _NewFinalFun} = T} -> + T + end. + +-spec do_rewrite(cfg(), mfa(), args_fun(), call_fun(), final_fun()) -> cfg(). + +do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun) -> + common_rewrite(Cfg, {MFA, ArgsFun, CallFun, FinalFun}). + +-spec ordinary_cfg(cfg(), mfa()) -> cfg(). + +ordinary_cfg(Cfg, MFA) -> + Data = make_data(Cfg,MFA), + common_rewrite(Cfg, Data). + +-spec common_rewrite(cfg(), data()) -> cfg(). + +common_rewrite(Cfg, Data) -> + State = safe_analyse(Cfg, Data), + State2 = rewrite_blocks(State), + Cfg1 = state__cfg(State2), + Cfg2 = hipe_icode_cfg:remove_unreachable_code(Cfg1), + Cfg3 = convert_cfg_to_types(Cfg2), + hipe_icode_type:specialize(Cfg3). + +-spec make_data(cfg(), mfa()) -> data(). + +make_data(Cfg, {_M,_F,A}=MFA) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg)+1; + false -> A + end, + Args = lists:duplicate(NoArgs, any_type()), + ArgsFun = fun(_,_) -> Args end, + CallFun = fun(_,_) -> any_type() end, + FinalFun = fun(_,_) -> ok end, + {MFA, ArgsFun, CallFun, FinalFun}. + +-spec analyse(cfg(), data()) -> 'ok'. + +analyse(Cfg, Data) -> + try + #state{} = safe_analyse(Cfg, Data), + ok + catch throw:no_input -> ok + end. + +-spec safe_analyse(cfg(), data()) -> #state{}. + +safe_analyse(CFG, Data={MFA,_,_,_}) -> + State = state__init(CFG, Data), + Work = init_work(State), + NewState = analyse_blocks(State, Work), + (state__result_action(NewState))(MFA, [state__ret_type(NewState)]), + NewState. + +-spec rewrite_blocks(#state{}) -> #state{}. + +rewrite_blocks(State) -> + CFG = state__cfg(State), + Start = hipe_icode_cfg:start_label(CFG), + rewrite_blocks([Start], State, [Start]). + +-spec rewrite_blocks([label()], #state{}, [label()]) -> #state{}. + +rewrite_blocks([Next|Rest], State, Visited) -> + Info = state__info_in(State, Next), + {NewState, NewLabels} = analyse_block(Next, Info, State, true), + NewLabelsSet = ordsets:from_list(NewLabels), + RealNew = ordsets:subtract(NewLabelsSet, Visited), + NewVisited = ordsets:union([RealNew, Visited, [Next]]), + NewWork = ordsets:union([RealNew, Rest]), + rewrite_blocks(NewWork, NewState, NewVisited); +rewrite_blocks([], State, _) -> + State. + +-spec analyse_blocks(#state{}, work_list()) -> #state{}. + +analyse_blocks(State, Work) -> + case get_work(Work) of + fixpoint -> + State; + {Label, NewWork} -> + Info = state__info_in(State, Label), + {NewState, NewLabels} = + try analyse_block(Label, Info, State, false) + catch throw:none_range -> + {State, []} + end, + NewWork2 = add_work(NewWork, NewLabels), + analyse_blocks(NewState, NewWork2) + end. + +-spec analyse_block(label(), info(), #state{}, boolean()) -> {#state{}, [label()]}. + +analyse_block(Label, Info, State, Rewrite) -> + BB = state__bb(State, Label), + Code = hipe_bb:code(BB), + {NewCode, InfoList, RetType} = + analyse_BB(Code, Info, [], Rewrite, state__lookup_fun(State)), + State1 = state__bb_add(State, Label, hipe_bb:mk_bb(NewCode)), + State2 = state__ret_type_update(State1, RetType), + state__update_info(State2, InfoList, Rewrite). + +-spec analyse_BB([icode_instr()], info(), [icode_instr()], boolean(), call_fun()) -> + {[icode_instr()], [{label(),info()}], #range{}}. + +analyse_BB([Last], Info, Code, Rewrite, LookupFun) -> + {{NewI, LabelInfoList}, RetType} = + analyse_last_insn(Last, Info, Rewrite, LookupFun), + {lists:reverse([NewI|Code]), LabelInfoList, RetType}; +analyse_BB([Insn|InsnList], Info, Code, Rewrite, LookupFun) -> + {NewInfo, NewI} = analyse_insn(Insn, Info, LookupFun), + analyse_BB(InsnList, NewInfo, [NewI|Code], Rewrite, LookupFun). + +-spec analyse_insn(icode_instr(), info(), call_fun()) -> {info(), icode_instr()}. + +analyse_insn(I, Info, LookupFun) -> + %% io:format("~w Info: ~p~n", [I, Info]), + NewI = handle_args(I,Info), + FinalI = + case NewI of + #icode_call{} -> analyse_call(NewI, LookupFun); + #icode_move{} -> analyse_move(NewI); + #icode_phi{} -> analyse_phi(NewI); + #icode_begin_handler{} -> analyse_begin_handler(NewI); + #icode_comment{} -> NewI + end, + {enter_vals(FinalI, Info), FinalI}. + +-spec handle_args(icode_instr(), info()) -> icode_instr(). + +handle_args(I, Info) -> + WidenFun = fun update_three/3, + handle_args(I, Info, WidenFun). + +-spec handle_args(icode_instr(), info(), three_range_fun()) -> icode_instr(). + +handle_args(I, Info, WidenFun) -> + Uses = hipe_icode:uses(I), + PresentRanges = [lookup(V, Info) || V <- Uses], + %% io:format("Uses: ~p~nRanges: ~p~n", [Uses, PresentRanges]), + JoinFun = fun(Var, Range) -> update_info(Var, Range, WidenFun) end, + NewUses = lists:zipwith(JoinFun, Uses, PresentRanges), + hipe_icode:subst_uses(lists:zip(Uses, NewUses),I). + +-spec join_info(#ann{}, #range{}, three_range_fun()) -> #ann{}. + +join_info(Ann = #ann{range = R1, type = Type, count = ?WIDEN}, R2, Fun) -> + Ann#ann{range = Fun(R1, R2, range_from_simple_type(Type))}; +join_info(Ann = #ann{range = R1, type = Type, count = C}, R2, _Fun) when C < ?WIDEN -> + case join_three(R1, R2, range_from_simple_type(Type)) of + R1 -> Ann; + NewR -> Ann#ann{range = NewR, count = C+1} + end. + +-spec join_three(#range{}, #range{}, #range{}) -> #range{}. + +join_three(R1, R2, R3) -> + inf(sup(R1, R2), R3). + +-spec update_info(variable(), #range{}) -> annotated_variable(). + +update_info(Var, Range) -> + update_info(Var, Range, fun update_three/3). + +-spec update_info(variable(), #range{}, three_range_fun()) -> annotated_variable(). + +update_info(Arg, R, Fun) -> + case hipe_icode:is_annotated_variable(Arg) of + true -> + Ann = hipe_icode:variable_annotation(Arg), + hipe_icode:annotate_variable(Arg, update_info1(Ann, R, Fun)); + false -> + Arg + end. + +-spec update_info1(any(), #range{}, three_range_fun()) -> range_anno(). + +update_info1({range_anno, Ann, _}, R2, Fun) -> + make_range_anno(update_ann(Ann,R2,Fun)); +update_info1({type_anno, Type, _}, R2, Fun) -> + make_range_anno(update_ann(type_to_ann(Type), R2, Fun)). + +update_ann(Ann = #ann{range = R1, type = Type, count = ?WIDEN}, R2, Fun) -> + Ann#ann{range = Fun(R1,R2,range_from_simple_type(Type))}; +update_ann(Ann = #ann{range = R1, type = Type, count = C}, R2, _Fun) -> + case update_three(R1, R2, range_from_simple_type(Type)) of + R1 -> Ann; + NewR -> Ann#ann{range = NewR, count = C+1} + end. + +-spec type_to_ann(erl_types:erl_type()) -> #ann{}. + +type_to_ann(Type) -> + #ann{range = range_from_simple_type(Type), type = t_limit(Type,1), count=1}. + +-spec make_range_anno(#ann{}) -> range_anno(). + +make_range_anno(Ann) -> + {range_anno, Ann, fun pp_ann/1}. + +-spec update_three(#range{}, #range{}, #range{}) -> #range{}. + +update_three(_R1, R2, R3) -> + inf(R2, R3). + +-spec safe_widen(#range{}, #range{}, #range{}) -> #range{}. + +safe_widen(#range{range=Old}, #range{range=New}, T = #range{range=Wide}) -> + ResRange = + case {Old,New,Wide} of + {{Min,Max1},{Min,Max2},{_,Max}} -> + case inf_geq(OMax = next_up_limit(inf_max([Max1,Max2])),Max) of + true -> {Min,Max}; + false -> {Min,OMax} + end; + {{Min1,Max},{Min2,Max},{Min,_}} -> + case inf_geq(Min, OMin = next_down_limit(inf_min([Min1,Min2]))) of + true -> {Min,Max}; + false -> {OMin,Max} + end; + {{Min1,Max1},{Min2,Max2},{Min,Max}} -> + RealMax = + case inf_geq(OMax = next_up_limit(inf_max([Max1,Max2])),Max) of + true -> Max; + false -> OMax + end, + RealMin = + case inf_geq(Min, OMin = next_down_limit(inf_min([Min1,Min2]))) of + true -> Min; + false -> OMin + end, + {RealMin,RealMax}; + _ -> + Wide + end, + T#range{range=ResRange}. + +-spec widen(#range{}, #range{}, #range{}) -> #range{}. + +widen(#range{range=Old}, #range{range=New}, T = #range{range=Wide}) -> + ResRange = + case {Old,New,Wide} of + {{Min,_},{Min,Max2},{_,Max}} -> + case inf_geq(OMax = next_up_limit(Max2),Max) of + true -> {Min,Max}; + false -> {Min,OMax} + end; + {{_,Max},{Min2,Max},{Min,_}} -> + case inf_geq(Min, OMin = next_down_limit(Min2)) of + true -> {Min,Max}; + false -> {OMin,Max} + end; + {_,{Min2,Max2},{Min,Max}} -> + RealMax = + case inf_geq(OMax = next_up_limit(Max2),Max) of + true -> Max; + false -> OMax + end, + RealMin = + case inf_geq(Min, OMin = next_down_limit(Min2)) of + true -> Min; + false -> OMin + end, + {RealMin,RealMax}; + _ -> + Wide + end, + T#range{range=ResRange}. + +-spec analyse_call(#icode_call{}, call_fun()) -> #icode_call{}. + +analyse_call(Call, LookupFun) -> + case hipe_icode:call_dstlist(Call) of + [] -> + Call; + Dsts -> + Args = hipe_icode:args(Call), + Fun = hipe_icode:call_fun(Call), + Type = hipe_icode:call_type(Call), + DstRanges = analyse_call_or_enter_fun(Fun, Args, Type, LookupFun), + NewDefs = [update_info(Var, R) || {Var,R} <- lists:zip(Dsts, DstRanges)], + hipe_icode:subst_defines(lists:zip(Dsts, NewDefs), Call) + end. + +-spec analyse_move(#icode_move{}) -> #icode_move{}. + +analyse_move(Move) -> + Src = hipe_icode:move_src(Move), + Dst = hipe_icode:move_dst(Move), + Range = get_range_from_arg(Src), + NewDst = update_info(Dst, Range), + hipe_icode:subst_defines([{Dst,NewDst}], Move). + +-spec analyse_begin_handler(#icode_begin_handler{}) -> #icode_begin_handler{}. + +analyse_begin_handler(Handler) -> + SubstList = + [{Dst,update_info(Dst,any_type())} || + Dst <- hipe_icode:begin_handler_dstlist(Handler)], + hipe_icode:subst_defines(SubstList, Handler). + +-spec analyse_phi(#icode_phi{}) -> #icode_phi{}. + +analyse_phi(Phi) -> + {_, Args} = lists:unzip(hipe_icode:phi_arglist(Phi)), + Dst = hipe_icode:phi_dst(Phi), + ArgRanges = get_range_from_args(Args), + %% io:format("Phi-Arg_ranges: ~p ~n", [Arg_ranges]), + DstRange = sup(ArgRanges), + NewDst = update_info(Dst, DstRange, fun widen/3), + hipe_icode:subst_defines([{Dst, NewDst}], Phi). + +-spec analyse_last_insn(icode_instr(), info(), boolean(), call_fun()) -> + last_instr_return(). + +analyse_last_insn(I, Info, Rewrite, LookupFun) -> + %% io:format("~w Info: ~p~n",[I,Info]), + NewI = handle_args(I, Info), + %% io:format("~w -> ~w~n",[NewI,I]), + case NewI of + #icode_return{} -> analyse_return(NewI, Info); + #icode_enter{} -> analyse_enter(NewI, Info, LookupFun); + #icode_switch_val{} -> + {analyse_switch_val(NewI, Info, Rewrite), none_type()}; + #icode_if{} -> {analyse_if(NewI, Info, Rewrite), none_type()}; + #icode_goto{} -> {analyse_goto(NewI, Info), none_type()}; + #icode_type{} -> {analyse_type(NewI, Info, Rewrite), none_type()}; + #icode_fail{} -> {analyse_fail(NewI, Info), none_type()}; + #icode_call{} -> {analyse_last_call(NewI, Info, LookupFun), none_type()}; + #icode_switch_tuple_arity{} -> + {analyse_switch_tuple_arity(NewI, Info), none_type()}; + #icode_begin_try{} -> {analyse_begin_try(NewI, Info), none_type()} + end. + +-spec analyse_return(#icode_return{}, info()) -> last_instr_return(). + +analyse_return(Insn, _Info) -> + [RetRange] = get_range_from_args(hipe_icode:return_vars(Insn)), + {{Insn,[]}, RetRange}. + +-spec analyse_enter(#icode_enter{}, info(), call_fun()) -> last_instr_return(). + +analyse_enter(Insn, _Info, LookupFun) -> + Args = hipe_icode:args(Insn), + Fun = hipe_icode:enter_fun(Insn), + CallType = hipe_icode:enter_type(Insn), + [RetRange] = analyse_call_or_enter_fun(Fun, Args, CallType, LookupFun), + {{Insn,[]}, RetRange}. + +-spec analyse_switch_val(#icode_switch_val{}, info(), boolean()) -> instr_split_info(). + +analyse_switch_val(Switch, Info, Rewrite) -> + Var = hipe_icode:switch_val_term(Switch), + SwitchRange = get_range_from_arg(Var), + Cases = hipe_icode:switch_val_cases(Switch), + {FailRange, LabelRangeList} = get_range_label_list(Cases, SwitchRange, []), + case range__is_none(FailRange) of + true -> + InfoList = update_infos(Var, Info, LabelRangeList), + if Rewrite -> {update_switch(Switch, LabelRangeList, false), InfoList}; + true -> {Switch, InfoList} + end; + false -> + FailLabel = hipe_icode:switch_val_fail_label(Switch), + InfoList = update_infos(Var, Info, [{FailRange, FailLabel}|LabelRangeList]), + if Rewrite -> {update_switch(Switch, LabelRangeList, true), InfoList}; + true -> {Switch, InfoList} + end + end. + +-spec update_infos(argument(), info(), [{#range{},label()}]) -> [{label(),info()}]. + +update_infos(Arg, Info, [{Range, Label}|Rest]) -> + [{Label,enter_define({Arg,Range},Info)} | update_infos(Arg,Info,Rest)]; +update_infos(_, _, []) -> []. + +-spec get_range_label_list([{argument(),label()}], #range{}, [{#range{},label()}]) -> + {#range{},[{#range{},label()}]}. + +get_range_label_list([{Val,Label}|Cases], SRange, Acc) -> + VRange = get_range_from_arg(Val), + None = none_type(), + case inf(SRange, VRange) of + None -> + get_range_label_list(Cases, SRange, Acc); + ResRange -> + get_range_label_list(Cases, SRange, [{ResRange,Label}|Acc]) + end; +get_range_label_list([], SRange, Acc) -> + {PointTypes, _} = lists:unzip(Acc), + {remove_point_types(SRange, PointTypes), Acc}. + +-spec update_switch(#icode_switch_val{}, [{#range{},label()}], boolean()) -> + #icode_switch_val{}. + +update_switch(Switch, LabelRangeList, KeepFail) -> + S2 = + case label_range_list_to_cases(LabelRangeList, []) of + no_update -> + Switch; + Cases -> + hipe_icode:switch_val_cases_update(Switch, Cases) + end, + if KeepFail -> S2; + true -> S2 + end. + +-spec label_range_list_to_cases([{#range{},label()}], [{#icode_const{},label()}]) -> + 'no_update' | [{#icode_const{},label()}]. + +label_range_list_to_cases([{#range{range={C,C},other=false},Label}|Rest], + Acc) when is_integer(C) -> + label_range_list_to_cases(Rest, [{hipe_icode:mk_const(C),Label}|Acc]); +label_range_list_to_cases([{_NotAConstantRange,_Label}|_Rest], _Acc) -> + no_update; +label_range_list_to_cases([], Acc) -> + lists:reverse(Acc). + +-spec analyse_switch_tuple_arity(#icode_switch_tuple_arity{}, info()) -> + {#icode_switch_tuple_arity{}, [{label(),info()}]}. + +analyse_switch_tuple_arity(Switch, Info) -> + Var = hipe_icode:switch_tuple_arity_term(Switch), + NewInfo = enter_define({Var, get_range_from_arg(Var)}, Info), + Cases = hipe_icode:switch_tuple_arity_cases(Switch), + Fail = hipe_icode:switch_tuple_arity_fail_label(Switch), + {_, Case_labels} = lists:unzip(Cases), + Labels = [Fail|Case_labels], + {Switch, [{Label,NewInfo} || Label <- Labels]}. + +-spec analyse_goto(#icode_goto{}, info()) -> {#icode_goto{}, [{label(),info()},...]}. + +analyse_goto(Insn, Info) -> + GotoLabel = hipe_icode:goto_label(Insn), + {Insn, [{GotoLabel,Info}]}. + +-spec analyse_fail(#icode_fail{}, info()) -> {#icode_fail{}, [{label(),info()}]}. + +analyse_fail(Fail, Info) -> + case hipe_icode:fail_label(Fail) of + [] -> {Fail, []}; + Label -> {Fail, [{Label,Info}]} + end. + +-spec analyse_begin_try(#icode_begin_try{}, info()) -> + {#icode_begin_try{}, [{label(),info()},...]}. + +analyse_begin_try(Insn, Info) -> + Label = hipe_icode:begin_try_label(Insn), + Successor = hipe_icode:begin_try_successor(Insn), + {Insn, [{Label,Info},{Successor,Info}]}. + +-spec analyse_last_call(#icode_call{}, info(), call_fun()) -> + {#icode_call{}, [{label(),info()},...]}. + +analyse_last_call(Call, Info, LookupFun) -> + %% hipe_icode_pp:pp_block([Insn]), + NewI = analyse_call(Call, LookupFun), + Continuation = hipe_icode:call_continuation(Call), + NewInfo = enter_vals(NewI, Info), + case hipe_icode:call_fail_label(Call) of + [] -> + {NewI, [{Continuation,NewInfo}]}; + Fail -> + {NewI, [{Continuation,NewInfo}, {Fail,Info}]} + end. + +-spec analyse_if(#icode_if{}, info(), boolean()) -> + {#icode_goto{} | #icode_if{}, [{label(),info()}]}. + +analyse_if(If, Info, Rewrite) -> + case hipe_icode:if_args(If) of + Args = [_,_] -> + analyse_sane_if(If, Info, Args, get_range_from_args(Args), Rewrite); + _ -> + TrueLabel = hipe_icode:if_true_label(If), + FalseLabel = hipe_icode:if_false_label(If), + {If, [{TrueLabel,Info},{FalseLabel,Info}]} + end. + +-spec analyse_sane_if(#icode_if{}, info(), [argument(),...], + [#range{},...], boolean()) -> + {#icode_goto{} | #icode_if{}, [{label(), info()}]}. + +analyse_sane_if(If, Info, [Arg1, Arg2], [Range1, Range2], Rewrite) -> + case normalize_name(hipe_icode:if_op(If)) of + '>' -> + {TrueRange2, TrueRange1, FalseRange2, FalseRange1} = + range_inequality_propagation(Range2, Range1); + '==' -> + {TempTrueRange1, TempTrueRange2, FalseRange1, FalseRange2}= + range_equality_propagation(Range1, Range2), + TrueRange1 = set_other(TempTrueRange1,other(Range1)), + TrueRange2 = set_other(TempTrueRange2,other(Range2)); + '<' -> + {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + range_inequality_propagation(Range1, Range2); + '>=' -> + {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = + range_inequality_propagation(Range1, Range2); + '=<' -> + {FalseRange2, FalseRange1, TrueRange2, TrueRange1} = + range_inequality_propagation(Range2, Range1); + '=:=' -> + {TrueRange1, TrueRange2, FalseRange1, FalseRange2}= + range_equality_propagation(Range1, Range2); + '=/=' -> + {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = + range_equality_propagation(Range1, Range2); + '/=' -> + {TempFalseRange1, TempFalseRange2, TrueRange1, TrueRange2}= + range_equality_propagation(Range1, Range2), + FalseRange1 = set_other(TempFalseRange1,other(Range1)), + FalseRange2 = set_other(TempFalseRange2,other(Range2)) + end, + TrueLabel = hipe_icode:if_true_label(If), + FalseLabel = hipe_icode:if_false_label(If), + TrueInfo = + enter_defines([{Arg1,TrueRange1}, {Arg2,TrueRange2}],Info), + FalseInfo = + enter_defines([{Arg1,FalseRange1}, {Arg2,FalseRange2}],Info), + True = + case lists:any(fun range__is_none/1,[TrueRange1,TrueRange2]) of + true -> []; + false -> [{TrueLabel,TrueInfo}] + end, + False = + case lists:any(fun range__is_none/1, [FalseRange1,FalseRange2]) of + true -> []; + false -> [{FalseLabel,FalseInfo}] + end, + UpdateInfo = True++False, + NewIF = + if Rewrite -> + %%io:format("~w~n~w~n", [{Arg1,FalseRange1},{Arg2,FalseRange2}]), + %%io:format("Any none: ~w~n", [lists:any(fun range__is_none/1,[FalseRange1,FalseRange2])]), + case UpdateInfo of + [] -> %%This is weird + If; + [{Label,_Info}] -> + hipe_icode:mk_goto(Label); + [_,_] -> + If + end; + true -> + If + end, + {NewIF, UpdateInfo}. + +-spec normalize_name(atom()) -> atom(). + +normalize_name(Name) -> + case Name of + 'fixnum_eq' -> '=:='; + 'fixnum_neq' -> '=/='; + 'fixnum_gt' -> '>'; + 'fixnum_lt' -> '<'; + 'fixnum_ge' -> '>='; + 'fixnum_le' -> '=<'; + Name -> Name + end. + +-spec range_equality_propagation(#range{}, #range{}) -> + {#range{}, #range{}, #range{}, #range{}}. + +range_equality_propagation(Range_1, Range_2) -> + True_range = inf(Range_1, Range_2), + case {range(Range_1), range(Range_2)} of + {{N,N},{ N,N}} -> + False_range_1 = none_range(), + False_range_2 = none_range(); + {{N1,N1}, {N2,N2}} -> + False_range_1 = Range_1, + False_range_2 = Range_2; + {{N,N}, _} -> + False_range_1 = Range_1, + {_,False_range_2} = compare_with_integer(N, Range_2); + {_, {N,N}} -> + False_range_2 = Range_2, + {_,False_range_1} = compare_with_integer(N, Range_1); + {_, _} -> + False_range_1 = Range_1, + False_range_2 = Range_2 + end, + {True_range, True_range, False_range_1, False_range_2}. + +-spec range_inequality_propagation(#range{}, #range{}) -> + {#range{}, #range{}, #range{}, #range{}}. + +%% Range1 < Range2 +range_inequality_propagation(Range1, Range2) -> + R1_other = other(Range1), + R2_other = other(Range2), + {R1_true_range, R1_false_range, R2_true_range, R2_false_range} = + case {range(Range1), range(Range2)} of + {{N1,N1}, {N2,N2}} -> + case inf_geq(N2,inf_add(N1,1)) of + true -> + {{N1,N1},empty,{N2,N2},empty}; + false -> + {empty,{N1,N1},empty,{N2,N2}} + end; + {{N1,N1}, {Min2,Max2}} -> + case inf_geq(Min2,inf_add(N1,1)) of + true -> + {{N1,N1},empty,{inf_add(N1,1),Max2},empty}; + false -> + case inf_geq(N1,Max2) of + true -> + {empty,{N1,N1},empty,{Min2,N1}}; + false -> + {{N1,N1},{N1,N1},{inf_add(N1,1),Max2},{Min2,N1}} + end + end; + {{Min1,Max1}, {N2,N2}} -> + case inf_geq(N2,inf_add(Max1,1)) of + true -> + {{Min1,inf_add(N2,-1)},empty,{N2,N2},empty}; + false -> + case inf_geq(Min1,N2) of + true -> + {empty,{N2,Max1},empty,{N2,N2}}; + false -> + {{Min1,inf_add(N2,-1)},{N2,Max1},{N2,N2},{N2,N2}} + end + end; + {empty, {Min2,Max2}} -> + {empty,empty,{Min2,Max2},{Min2,Max2}}; + {{Min1,Max1}, empty} -> + {{Min1,Max1},{Min1,Max1},empty,empty}; + {empty, empty} -> + {empty,empty,empty,empty}; + {{Min1,Max1}, {Min2,Max2}} -> + {{Min1,inf_min([Max1,inf_add(Max2,-1)])}, + {inf_max([Min1,Min2]),Max1}, + {inf_max([inf_add(Min1,1),Min2]),Max2}, + {Min2,inf_min([Max1,Max2])}} + end, + {range_init(R1_true_range, R1_other), + range_init(R2_true_range, R2_other), + range_init(R1_false_range, R1_other), + range_init(R2_false_range, R2_other)}. + +-spec analyse_type(#icode_type{}, info(), boolean()) -> + {#icode_goto{} | #icode_type{}, [{label(),info()}]}. + +analyse_type(Type, Info, Rewrite) -> + TypeTest = hipe_icode:type_test(Type), + [Arg|_] = hipe_icode:type_args(Type), + OldVarRange = get_range_from_arg(Arg), + case TypeTest of + {integer, N} -> + {TrueRange,FalseRange} = compare_with_integer(N,OldVarRange); + integer -> + TrueRange = inf(any_range(), OldVarRange), + FalseRange = inf(none_range(), OldVarRange); + _ -> + TrueRange = inf(none_range(),OldVarRange), + FalseRange = OldVarRange + end, + TrueLabel = hipe_icode:type_true_label(Type), + FalseLabel = hipe_icode:type_false_label(Type), + TrueInfo = + enter_define({Arg,TrueRange},Info), + FalseInfo = + enter_define({Arg,FalseRange},Info), + True = + case range__is_none(TrueRange) of + true -> []; + false -> [{TrueLabel,TrueInfo}] + end, + False = + case range__is_none(FalseRange) of + true -> []; + false -> [{FalseLabel,FalseInfo}] + end, + UpdateInfo = True++False, + NewType = + if Rewrite -> + case UpdateInfo of + [] -> %% This is weird + Type; + [{Label,_Info}] -> + hipe_icode:mk_goto(Label); + [_,_] -> + Type + end; + true -> + Type + end, + {NewType,True ++ False}. + +-spec compare_with_integer(integer(), #range{}) -> {#range{}, #range{}}. + +compare_with_integer(N, OldVarRange) -> + TestRange = range_init({N, N}, false), + TrueRange = inf(TestRange, OldVarRange), + %% False range + TempFalseRange = range__remove_constant(OldVarRange, TestRange), + BetterRange = + case range(TempFalseRange) of + {Min, Max} = MM -> + New_small = inf_geq(Min, N), + New_large = inf_geq(N, Max), + if New_small and not New_large -> + {N + 1, Max}; + New_large and not New_small -> + {Min, N - 1}; + true -> + MM + end; + Not_tuple -> + Not_tuple + end, + FalseRange = range_init(BetterRange, other(TempFalseRange)), + {TrueRange, FalseRange}. + +%%== Ranges ================================================================== + +-spec pp_ann(#ann{} | erl_types:erl_type()) -> [string()]. + +pp_ann(#ann{range=#range{range=R, other=false}}) -> + pp_range(R); +pp_ann(#ann{range=#range{range=empty, other=true}, type=Type}) -> + t_to_string(Type); +pp_ann(#ann{range=#range{range=R, other=true}, type=Type}) -> + pp_range(R) ++ " | " ++ t_to_string(Type); +pp_ann(Type) -> + t_to_string(Type). + +-spec pp_range(range_rep()) -> nonempty_string(). + +pp_range(empty) -> + "none"; +pp_range({Min, Max}) -> + val_to_string(Min) ++ ".." ++ val_to_string(Max). + +-spec val_to_string('pos_inf' | 'neg_inf' | integer()) -> string(). + +val_to_string(pos_inf) -> "inf"; +val_to_string(neg_inf) -> "-inf"; +val_to_string(X) when is_integer(X) -> integer_to_list(X). + +-spec range_from_type(erl_types:erl_type()) -> [#range{}]. + +range_from_type(Type) -> + [range_from_simple_type(T) || T <- t_to_tlist(Type)]. + +-spec range_from_simple_type(erl_types:erl_type()) -> #range{}. + +range_from_simple_type(Type) -> + None = t_none(), + case t_inf(t_integer(), Type) of + None -> + #range{range = empty, other = true}; + Type -> + Range = {number_min(Type), number_max(Type)}, + #range{range = Range, other = false}; + NewType -> + Range = {number_min(NewType), number_max(NewType)}, + #range{range = Range, other = true} + end. + +-spec range_init(range_rep(), boolean()) -> #range{}. + +range_init({Min, Max} = Range, Other) -> + case inf_geq(Max, Min) of + true -> + #range{range = Range, other = Other}; + false -> + #range{range = empty, other = Other} + end; +range_init(empty, Other) -> + #range{range = empty, other = Other}. + +-spec range(#range{}) -> range_rep(). + +range(#range{range = R}) -> R. + +-spec other(#range{}) -> boolean(). + +other(#range{other = O}) -> O. + +-spec set_other(#range{}, boolean()) -> #range{}. + +set_other(R, O) -> R#range{other = O}. + +-spec range__min(#range{}) -> 'empty' | 'neg_inf' | integer(). + +range__min(#range{range=empty}) -> empty; +range__min(#range{range={Min,_}}) -> Min. + +-spec range__max(#range{}) -> 'empty' | 'pos_inf' | integer(). + +range__max(#range{range=empty}) -> empty; +range__max(#range{range={_,Max}}) -> Max. + +-spec range__is_none(#range{}) -> boolean(). + +range__is_none(#range{range=empty, other=false}) -> true; +range__is_none(#range{}) -> false. + +-spec range__is_empty(#range{}) -> boolean(). + +range__is_empty(#range{range=empty}) -> true; +range__is_empty(#range{range={_,_}}) -> false. + +-spec remove_point_types(#range{}, [#range{}]) -> #range{}. + +remove_point_types(Range, Ranges) -> + Sorted = lists:sort(Ranges), + FoldFun = fun (R, Acc) -> range__remove_constant(Acc,R) end, + Range1 = lists:foldl(FoldFun, Range, Sorted), + lists:foldl(FoldFun, Range1, lists:reverse(Sorted)). + +-spec range__remove_constant(#range{}, #range{}) -> #range{}. + +range__remove_constant(R = #range{range={C,C}}, #range{range={C,C}}) -> + R#range{range=empty}; +range__remove_constant(R = #range{range={C,H}}, #range{range={C,C}}) -> + R#range{range={C+1,H}}; +range__remove_constant(R = #range{range={L,C}}, #range{range={C,C}}) -> + R#range{range={L,C-1}}; +range__remove_constant(R = #range{}, #range{range={C,C}}) -> + R; +range__remove_constant(R = #range{}, _) -> + R. + +-spec any_type() -> #range{}. + +any_type() -> + #range{range=any_r(), other=true}. + +-spec any_range() -> #range{}. + +any_range() -> + #range{range=any_r(), other=false}. + +-spec none_range() -> #range{}. + +none_range() -> + #range{range=empty, other=true}. + +-spec none_type() -> #range{}. + +none_type() -> + #range{range = empty, other = false}. + +-spec any_r() -> {'neg_inf','pos_inf'}. + +any_r() -> {neg_inf, pos_inf}. + +-spec get_range_from_args([argument()]) -> [#range{}]. + +get_range_from_args(Args) -> + [get_range_from_arg(Arg) || Arg <- Args]. + +-spec get_range_from_arg(argument()) -> #range{}. + +get_range_from_arg(Arg) -> + case hipe_icode:is_const(Arg) of + true -> + Value = hipe_icode:const_value(Arg), + case is_integer(Value) of + true -> + #range{range={Value,Value}, other=false}; + false -> + #range{range=empty, other=true} + end; + false -> + case hipe_icode:is_annotated_variable(Arg) of + true -> + case hipe_icode:variable_annotation(Arg) of + {range_anno, #ann{range=Range}, _} -> + Range; + {type_anno, Type, _} -> + range_from_simple_type(Type) + end; + false -> + any_type() + end + end. + +%% inf([R]) -> +%% R; +%% inf([R1,R2|Rest]) -> +%% inf([inf(R1,R2)|Rest]). + +-spec inf(#range{}, #range{}) -> #range{}. + +inf(#range{range=R1, other=O1}, #range{range=R2, other=O2}) -> + #range{range=range_inf(R1,R2), other=other_inf(O1,O2)}. + +-spec range_inf(range_rep(), range_rep()) -> range_rep(). + +range_inf(empty, _) -> empty; +range_inf(_, empty) -> empty; +range_inf({Min1,Max1}, {Min2,Max2}) -> + NewMin = inf_max([Min1,Min2]), + NewMax = inf_min([Max1,Max2]), + case inf_geq(NewMax, NewMin) of + true -> + {NewMin, NewMax}; + false -> + empty + end. + +-spec other_inf(boolean(), boolean()) -> boolean(). + +other_inf(O1, O2) -> O1 and O2. + +-spec sup([#range{},...]) -> #range{}. + +sup([R]) -> + R; +sup([R1,R2|Rest]) -> + sup([sup(R1, R2)|Rest]). + +-spec sup(#range{}, #range{}) -> #range{}. + +sup(#range{range=R1,other=O1}, #range{range=R2,other=O2}) -> + #range{range=range_sup(R1,R2), other=other_sup(O1,O2)}. + +-spec range_sup(range_rep(), range_rep()) -> range_rep(). + +range_sup(empty, R) -> R; +range_sup(R, empty) -> R; +range_sup({Min1,Max1}, {Min2,Max2}) -> + NewMin = inf_min([Min1,Min2]), + NewMax = inf_max([Max1,Max2]), + {NewMin,NewMax}. + +-spec other_sup(boolean(), boolean()) -> boolean(). + +other_sup(O1, O2) -> O1 or O2. + +%%== Call Support ============================================================= + +-spec analyse_call_or_enter_fun(fun_name(), [argument()], + icode_call_type(), call_fun()) -> [#range{}]. + +analyse_call_or_enter_fun(Fun, Args, CallType, LookupFun) -> + %%io:format("Fun: ~p~n Args: ~p~n CT: ~p~n LF: ~p~n", [Fun, Args, CallType, LookupFun]), + case basic_type(Fun) of + {bin, Operation} -> + [Arg_range1,Arg_range2] = get_range_from_args(Args), + A1_is_empty = range__is_empty(Arg_range1), + A2_is_empty = range__is_empty(Arg_range2), + case A1_is_empty orelse A2_is_empty of + true -> + [none_type()]; + false -> + [Operation(Arg_range1, Arg_range2)] + end; + {unary, Operation} -> + [Arg_range] = get_range_from_args(Args), + case range__is_empty(Arg_range) of + true -> + [none_type()]; + false -> + [Operation(Arg_range)] + end; + {fcall, MFA} -> + case CallType of + local -> + Range = LookupFun(MFA, get_range_from_args(Args)), + case range__is_none(Range) of + true -> + throw(none_range); + false -> + [Range] + end; + remote -> + [any_type()] + end; + not_int -> + [any_type()]; + not_analysed -> + [any_type()]; + {hipe_bs_primop, {bs_get_integer, Size, Flags}} -> + {Min, Max} = analyse_bs_get_integer(Size, Flags, length(Args) =:= 1), + [#range{range={Min, Max}, other=false}, any_type()]; + {hipe_bs_primop, _} = Primop -> + Type = hipe_icode_primops:type(Primop), + range_from_type(Type) + end. + +-type bin_operation() :: fun((#range{},#range{}) -> #range{}). +-type unary_operation() :: fun((#range{}) -> #range{}). + +-spec basic_type(fun_name()) -> 'not_int' | 'not_analysed' + | {bin, bin_operation()} + | {unary, unary_operation()} + | {fcall, mfa()} | {hipe_bs_primop, _}. + +%% Arithmetic operations +basic_type('+') -> {bin, fun(R1, R2) -> range_add(R1, R2) end}; +basic_type('-') -> {bin, fun(R1, R2) -> range_sub(R1, R2) end}; +basic_type('*') -> {bin, fun(R1, R2) -> range_mult(R1, R2) end}; +basic_type('/') -> not_int; +basic_type('div') -> {bin, fun(R1, R2) -> range_div(R1, R2) end}; +basic_type('rem') -> {bin, fun(R1, R2) -> range_rem(R1, R2) end}; +basic_type('bor') -> {bin, fun(R1, R2) -> range_bor(R1, R2) end}; +basic_type('band') -> {bin, fun(R1, R2) -> range_band(R1, R2) end}; +basic_type('bxor') -> {bin, fun(R1, R2) -> range_bxor(R1, R2) end}; +basic_type('bnot') -> {unary, fun(R1) -> range_bnot(R1) end}; +basic_type('bsl') -> {bin, fun(R1, R2) -> range_bsl(R1, R2) end}; +basic_type('bsr') -> {bin, fun(R1, R2) -> range_bsr(R1, R2) end}; +%% unsafe_* +basic_type('unsafe_bor') -> + {bin, fun(R1, R2) -> range_bor(R1, R2) end}; +basic_type('unsafe_band') -> + {bin, fun(R1, R2) -> range_band(R1, R2) end}; +basic_type('unsafe_bxor') -> + {bin, fun(R1, R2) -> range_bxor(R1, R2) end}; +basic_type('unsafe_bnot') -> + {unary, fun(R1) -> range_bnot(R1) end}; +basic_type('unsafe_bsl') -> + {bin, fun(R1, R2) -> range_bsl(R1, R2) end}; +basic_type('unsafe_bsr') -> + {bin, fun(R1, R2) -> range_bsr(R1, R2) end}; +basic_type('unsafe_add') -> + {bin, fun(R1, R2) -> range_add(R1, R2) end}; +basic_type('unsafe_sub') -> + {bin, fun(R1, R2) -> range_sub(R1, R2) end}; +basic_type('extra_unsafe_add') -> + {bin, fun(R1, R2) -> range_add(R1, R2) end}; +basic_type('extra_unsafe_sub') -> + {bin, fun(R1, R2) -> range_sub(R1, R2) end}; +%% Binaries +basic_type({hipe_bs_primop, _} = Primop) -> Primop; +%% Unknown, other +basic_type(call_fun) -> not_analysed; +basic_type(clear_timeout) -> not_analysed; +basic_type(redtest) -> not_analysed; +basic_type(set_timeout) -> not_analysed; +basic_type(#apply_N{}) -> not_analysed; +basic_type(#closure_element{}) -> not_analysed; +basic_type(#gc_test{}) -> not_analysed; +%% Message handling +basic_type(check_get_msg) -> not_analysed; +basic_type(next_msg) -> not_analysed; +basic_type(select_msg) -> not_analysed; +basic_type(suspend_msg) -> not_analysed; +%% Functions +basic_type(enter_fun) -> not_analysed; +basic_type(#mkfun{}) -> not_int; +basic_type({_M,_F,_A} = MFA) -> {fcall, MFA}; +%% Floats +basic_type(conv_to_float) -> not_int; +basic_type(fclearerror) -> not_analysed; +basic_type(fcheckerror) -> not_analysed; +basic_type(fnegate) -> not_int; +basic_type(fp_add) -> not_int; +basic_type(fp_div) -> not_int; +basic_type(fp_mul) -> not_int; +basic_type(fp_sub) -> not_int; +basic_type(unsafe_tag_float) -> not_int; +basic_type(unsafe_untag_float) -> not_int; +%% Lists, tuples, records +basic_type(cons) -> not_int; +basic_type(mktuple) -> not_int; +basic_type(unsafe_hd) -> not_analysed; +basic_type(unsafe_tl) -> not_int; +basic_type(#element{}) -> not_analysed; +basic_type(#unsafe_element{}) -> not_analysed; +basic_type(#unsafe_update_element{}) -> not_analysed. + +-spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple(). + +analyse_bs_get_integer(Size, Flags, true) -> + Signed = Flags band 4, + if Signed =:= 0 -> + Max = 1 bsl Size - 1, + Min = 0; + true -> + Max = 1 bsl (Size-1) - 1, + Min = -(1 bsl (Size-1)) + end, + {Min, Max}; +analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), + is_integer(Flags) -> + any_r(). + +%%--------------------------------------------------------------------------- +%% Range operations +%%--------------------------------------------------------------------------- + +%% Arithmetic + +-spec range_add(#range{}, #range{}) -> #range{}. + +range_add(Range1, Range2) -> + NewMin = inf_add(range__min(Range1), range__min(Range2)), + NewMax = inf_add(range__max(Range1), range__max(Range2)), + Other = other(Range1) orelse other(Range2), + range_init({NewMin, NewMax}, Other). + +-spec range_sub(#range{}, #range{}) -> #range{}. + +range_sub(Range1, Range2) -> + Min_sub = inf_min([inf_inv(range__max(Range2)), + inf_inv(range__min(Range2))]), + Max_sub = inf_max([inf_inv(range__max(Range2)), + inf_inv(range__min(Range2))]), + NewMin = inf_add(range__min(Range1), Min_sub), + NewMax = inf_add(range__max(Range1), Max_sub), + Other = other(Range1) orelse other(Range2), + range_init({NewMin, NewMax}, Other). + +-spec range_mult(#range{}, #range{}) -> #range{}. + +range_mult(#range{range=empty, other=true}, _Range2) -> + range_init(empty, true); +range_mult(_Range1, #range{range=empty, other=true}) -> + range_init(empty, true); +range_mult(Range1, Range2) -> + Min1 = range__min(Range1), + Min2 = range__min(Range2), + Max1 = range__max(Range1), + Max2 = range__max(Range2), + GreaterMin1 = inf_greater_zero(Min1), + GreaterMin2 = inf_greater_zero(Min2), + GreaterMax1 = inf_greater_zero(Max1), + GreaterMax2 = inf_greater_zero(Max2), + Range = + if GreaterMin1 -> + if GreaterMin2 -> {inf_mult(Min1, Min2), inf_mult(Max1, Max2)}; + GreaterMax2 -> {inf_mult(Min2, Max1), inf_mult(Max2, Max1)}; + true -> {inf_mult(Min2, Max1), inf_mult(Max2, Min1)} + end; + %% Column 1 or 2 + GreaterMin2 -> % Column 1 or 2 row 3 + range(range_mult(Range2, Range1)); + GreaterMax1 -> % Column 2 Row 1 or 2 + if GreaterMax2 -> % Column 2 Row 2 + NewMin = inf_min([inf_mult(Min2, Max1), inf_mult(Max2, Min1)]), + NewMax = inf_max([inf_mult(Min2, Min1), inf_mult(Max2, Max1)]), + {NewMin, NewMax}; + true -> % Column 2 Row 1 + {inf_mult(Min2, Max1), inf_mult(Min2, Min1)} + end; + GreaterMax2 -> % Column 1 Row 2 + range(range_mult(Range2, Range1)); + true -> % Column 1 Row 1 + {inf_mult(Max1, Max2), inf_mult(Min2, Min1)} + end, + Other = other(Range1) orelse other(Range2), + range_init(Range, Other). + +-spec extreme_divisors(#range{}) -> range_tuple(). + +extreme_divisors(#range{range={0,0}}) -> {0,0}; +extreme_divisors(#range{range={0,Max}}) -> {1,Max}; +extreme_divisors(#range{range={Min,0}}) -> {Min,-1}; +extreme_divisors(#range{range={Min,Max}}) -> + case inf_geq(Min, 0) of + true -> {Min, Max}; + false -> % Min < 0 + case inf_geq(0, Max) of + true -> {Min,Max}; % Max < 0 + false -> {-1,1} % Max > 0 + end + end. + +-spec range_div(#range{}, #range{}) -> #range{}. + +%% this is div, not /. +range_div(_, #range{range={0,0}}) -> + range_init(empty, false); +range_div(#range{range=empty}, _) -> + range_init(empty, false); +range_div(_, #range{range=empty}) -> + range_init(empty, false); +range_div(Range1, Den) -> + Min1 = range__min(Range1), + Max1 = range__max(Range1), + {Min2, Max2} = extreme_divisors(Den), + Min_max_list = [inf_div(Min1, Min2), inf_div(Min1, Max2), + inf_div(Max1, Min2), inf_div(Max1, Max2)], + range_init({inf_min(Min_max_list), inf_max(Min_max_list)}, false). + +-spec range_rem(#range{}, #range{}) -> #range{}. + +range_rem(Range1, Range2) -> + %% Range1 desides the sign of the answer. + Min1 = range__min(Range1), + Max1 = range__max(Range1), + Min2 = range__min(Range2), + Max2 = range__max(Range2), + Min1_geq_zero = inf_geq(Min1, 0), + Max1_leq_zero = inf_geq(0, Max1), + Max_range2 = inf_max([inf_abs(Min2), inf_abs(Max2)]), + Max_range2_leq_zero = inf_geq(0, Max_range2), + New_min = + if Min1_geq_zero -> 0; + Max_range2_leq_zero -> Max_range2; + true -> inf_inv(Max_range2) + end, + New_max = + if Max1_leq_zero -> 0; + Max_range2_leq_zero -> inf_inv(Max_range2); + true -> Max_range2 + end, + range_init({New_min, New_max}, false). + +%%--- Bit operations ---------------------------- + +-spec range_bsr(#range{}, #range{}) -> #range{}. + +range_bsr(Range1, Range2=#range{range={Min, Max}}) -> + New_Range2 = range_init({inf_inv(Max), inf_inv(Min)}, other(Range2)), + Ans = range_bsl(Range1, New_Range2), + %% io:format("bsr res:~w~nInput:= ~w~n", [Ans, {Range1,Range2}]), + Ans. + +-spec range_bsl(#range{}, #range{}) -> #range{}. + +range_bsl(Range1, Range2) -> + Min1 = range__min(Range1), + Min2 = range__min(Range2), + Max1 = range__max(Range1), + Max2 = range__max(Range2), + Min1Geq0 = inf_geq(Min1, 0), + Max1Less0 = not inf_geq(Max1, 0), + MinMax = + if Min1Geq0 -> + {inf_bsl(Min1, Min2), inf_bsl(Max1, Max2)}; + true -> + if Max1Less0 -> {inf_bsl(Min1, Max2), inf_bsl(Max1, Min2)}; + true -> {inf_bsl(Min1, Max2), inf_bsl(Max1, Max2)} + end + end, + range_init(MinMax, false). + +-spec range_bnot(#range{}) -> #range{}. + +range_bnot(Range) -> + Minus_one = range_init({-1,-1}, false), + range_add(range_mult(Range, Minus_one), Minus_one). + +-spec width(range_rep() | integer()) -> 'pos_inf' | non_neg_integer(). + +width({Min, Max}) -> inf_max([width(Min), width(Max)]); +width(pos_inf) -> pos_inf; +width(neg_inf) -> pos_inf; +width(X) when is_integer(X), X >= 0 -> poswidth(X, 0); +width(X) when is_integer(X), X < 0 -> negwidth(X, 0). + +-spec poswidth(non_neg_integer(), non_neg_integer()) -> non_neg_integer(). + +poswidth(X, N) -> + case X < (1 bsl N) of + true -> N; + false -> poswidth(X, N+1) + end. + +-spec negwidth(neg_integer(), non_neg_integer()) -> non_neg_integer(). + +negwidth(X, N) -> + case X > (-1 bsl N) of + true -> N; + false -> negwidth(X, N+1) + end. + +-spec range_band(#range{}, #range{}) -> #range{}. + +range_band(R1, R2) -> + {_Min1, Max1} = MM1 = range(R1), + {_Min2, Max2} = MM2 = range(R2), + Width1 = width(MM1), + Width2 = width(MM2), + Range = + case {classify_range(R1), classify_range(R2)} of + {minus_minus, minus_minus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), -1}; + {minus_minus, minus_plus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), Max2}; + {minus_minus, plus_plus} -> + {0, Max2}; + {minus_plus, minus_minus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), Max1}; + {minus_plus, minus_plus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), inf_max([Max1, Max2])}; + {minus_plus, plus_plus} -> + {0, Max2}; + {plus_plus, minus_minus} -> + {0, Max1}; + {plus_plus, minus_plus} -> + {0, Max1}; + {plus_plus, plus_plus} -> + {0, inf_min([Max1, Max2])} + end, + range_init(Range, false). + +-spec range_bor(#range{}, #range{}) -> #range{}. + +range_bor(R1, R2) -> + {Min1, _Max1} = MM1 = range(R1), + {Min2, _Max2} = MM2 = range(R2), + Width1 = width(MM1), + Width2 = width(MM2), + Range = + case {classify_range(R1), classify_range(R2)} of + {minus_minus, minus_minus} -> + {inf_max([Min1, Min2]), -1}; + {minus_minus, minus_plus} -> + {Min1, -1}; + {minus_minus, plus_plus} -> + {Min1, -1}; + {minus_plus, minus_minus} -> + {Min2, -1}; + {minus_plus, minus_plus} -> + Width = inf_max([Width1, Width2]), + {inf_min([Min1, Min2]), inf_add(-1, inf_bsl(1, Width))}; + {minus_plus, plus_plus} -> + Width = inf_max([Width1, Width2]), + {Min1, inf_add(-1, inf_bsl(1, Width))}; + {plus_plus, minus_minus} -> + {Min2, -1}; + {plus_plus, minus_plus} -> + Width = inf_max([Width1, Width2]), + {Min2, inf_add(-1, inf_bsl(1, Width))}; + {plus_plus, plus_plus} -> + Width = inf_max([Width1, Width2]), + {0, inf_add(-1, inf_bsl(1, Width))} + end, + range_init(Range, false). + +-spec classify_range(#range{}) -> 'minus_minus' | 'minus_plus' | 'plus_plus'. + +classify_range(Range) -> + case range(Range) of + {neg_inf, Number} when is_integer(Number), Number < 0 -> minus_minus; + {neg_inf, Number} when is_integer(Number), Number >= 0 -> minus_plus; + {Number, pos_inf} when is_integer(Number), Number < 0 -> minus_plus; + {Number, pos_inf} when is_integer(Number), Number >= 0 -> plus_plus; + {neg_inf, pos_inf} -> minus_plus; + {Number1,Number2} when is_integer(Number1), is_integer(Number2) -> + classify_int_range(Number1, Number2) + end. + +-spec classify_int_range(integer(), integer()) -> + 'minus_minus' | 'minus_plus' | 'plus_plus'. + +classify_int_range(Number1, _Number2) when Number1 >= 0 -> + plus_plus; +classify_int_range(_Number1, Number2) when Number2 < 0 -> + minus_minus; +classify_int_range(_Number1, _Number2) -> + minus_plus. + +-spec range_bxor(#range{}, #range{}) -> #range{}. + +range_bxor(R1, R2) -> + {Min1, Max1} = MM1 = range(R1), + {Min2, Max2} = MM2 = range(R2), + Width1 = width(MM1), + Width2 = width(MM2), + Range = + case {classify_range(R1), classify_range(R2)} of + {minus_minus, minus_minus} -> + Width = inf_max([Width1, Width2]), + {0, inf_add(-1, inf_bsl(1, Width))}; + {minus_minus, minus_plus} -> + MinWidth = inf_max([Width1, width({0,Max2})]), + MaxWidth = inf_max([Width1, width({Min2,-1})]), + {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))}; + {minus_minus, plus_plus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), -1}; + {minus_plus, minus_minus} -> + MinWidth = inf_max([Width2,width({0,Max1})]), + MaxWidth = inf_max([Width2,width({Min1,-1})]), + {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))}; + {minus_plus, minus_plus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), inf_add(-1, inf_bsl(1, Width))}; + {minus_plus, plus_plus} -> + MinWidth = inf_max([Width2,width({Min1,-1})]), + MaxWidth = inf_max([Width2,width({0,Max1})]), + {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))}; + {plus_plus, minus_minus} -> + Width = inf_max([Width1, Width2]), + {inf_bsl(-1, Width), -1}; + {plus_plus, minus_plus} -> + MinWidth = inf_max([Width1,width({Min2,-1})]), + MaxWidth = inf_max([Width1,width({0,Max2})]), + {inf_bsl(-1, MinWidth), inf_add(-1, inf_bsl(1, MaxWidth))}; + {plus_plus, plus_plus} -> + Width = inf_max([Width1, Width2]), + {0, inf_add(-1, inf_bsl(1, Width))} + end, + range_init(Range, false). + +%%--------------------------------------------------------------------------- +%% Inf operations +%%--------------------------------------------------------------------------- + +-spec inf_max([inf_integer(),...]) -> inf_integer(). + +inf_max([H|T]) -> + lists:foldl(fun (Elem, Max) -> + case inf_geq(Elem, Max) of + false -> Max; + true -> Elem + end + end, H, T). + +-spec inf_min([inf_integer(),...]) -> inf_integer(). + +inf_min([H|T]) -> + lists:foldl(fun (Elem, Min) -> + case inf_geq(Elem, Min) of + true -> Min; + false -> Elem + end + end, H, T). + +-spec inf_abs(inf_integer()) -> 'pos_inf' | integer(). + +inf_abs(pos_inf) -> pos_inf; +inf_abs(neg_inf) -> pos_inf; +inf_abs(Number) when is_integer(Number), (Number < 0) -> - Number; +inf_abs(Number) when is_integer(Number) -> Number. + +-spec inf_add(inf_integer(), inf_integer()) -> inf_integer(). + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(neg_inf, _Number) -> neg_inf; +inf_add(_Number, pos_inf) -> pos_inf; +inf_add(_Number, neg_inf) -> neg_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. + +-spec inf_inv(inf_integer()) -> inf_integer(). + +inf_inv(pos_inf) -> neg_inf; +inf_inv(neg_inf) -> pos_inf; +inf_inv(Number) -> -Number. + +-spec inf_geq(inf_integer(), inf_integer()) -> boolean(). + +inf_geq(pos_inf, _) -> true; +inf_geq(_, pos_inf) -> false; +inf_geq(_, neg_inf) -> true; +inf_geq(neg_inf, _) -> false; +inf_geq(A, B) -> A >= B. + +-spec inf_greater_zero(inf_integer()) -> boolean(). + +inf_greater_zero(pos_inf) -> true; +inf_greater_zero(neg_inf) -> false; +inf_greater_zero(Number) when is_integer(Number), Number >= 0 -> true; +inf_greater_zero(Number) when is_integer(Number), Number < 0 -> false. + +-spec inf_div(inf_integer(), inf_integer()) -> inf_integer(). + +inf_div(Number, 0) -> + Greater = inf_greater_zero(Number), + if Greater -> pos_inf; + true -> neg_inf + end; +inf_div(pos_inf, Number) -> + Greater = inf_greater_zero(Number), + if Greater -> pos_inf; + true -> neg_inf + end; +inf_div(neg_inf, Number) -> + Greater = inf_greater_zero(Number), + if Greater -> neg_inf; + true -> pos_inf + end; +inf_div(Number, pos_inf) -> + Greater = inf_greater_zero(Number), + if Greater -> pos_inf; + true -> neg_inf + end; +inf_div(Number, neg_inf) -> + Greater = inf_greater_zero(Number), + if Greater -> neg_inf; + true -> pos_inf + end; +inf_div(Number1, Number2) -> Number1 div Number2. + +-spec inf_mult(inf_integer(), inf_integer()) -> inf_integer(). + +inf_mult(neg_inf, Number) -> + Greater = inf_greater_zero(Number), + if Greater -> neg_inf; + true -> pos_inf + end; +inf_mult(pos_inf, Number) -> + Greater = inf_greater_zero(Number), + if Greater -> pos_inf; + true -> neg_inf + end; +inf_mult(Number, pos_inf) -> inf_mult(pos_inf, Number); +inf_mult(Number, neg_inf) -> inf_mult(neg_inf, Number); +inf_mult(Number1, Number2) -> Number1 * Number2. + +-spec inf_bsl(inf_integer(), inf_integer()) -> inf_integer(). + +inf_bsl(pos_inf, _) -> pos_inf; +inf_bsl(neg_inf, _) -> neg_inf; +inf_bsl(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf; +inf_bsl(_, pos_inf) -> neg_inf; +inf_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0; +inf_bsl(_Number, neg_inf) -> -1; +inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + %% We can not shift left with a number which is not a fixnum. We + %% don't have enough memory. + Bits = ?BITS, + if Number2 > (Bits bsl 1) -> inf_bsl(Number1, pos_inf); + Number2 < (-Bits bsl 1) -> inf_bsl(Number1, neg_inf); + true -> Number1 bsl Number2 + end. + +%% State + +-spec state__init(cfg(), data()) -> #state{}. + +state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> + Start = hipe_icode_cfg:start_label(Cfg), + Params = hipe_icode_cfg:params(Cfg), + Ranges = ArgsFun(MFA, Cfg), + %% io:format("MFA: ~w~nRanges: ~w~n", [MFA, Ranges]), + Liveness = + hipe_icode_ssa:ssa_liveness__analyze(hipe_icode_type:unannotate_cfg(Cfg)), + case lists:any(fun range__is_none/1, Ranges) of + true -> + FinalFun(MFA, [none_type()]), + throw(no_input); + false -> + NewParams = lists:zipwith(fun update_info/2, Params, Ranges), + NewCfg = hipe_icode_cfg:params_update(Cfg, NewParams), + Info = enter_defines(NewParams, gb_trees:empty()), + InfoMap = gb_trees:insert({Start, in}, Info, gb_trees:empty()), + #state{info_map=InfoMap, cfg=NewCfg, liveness=Liveness, + ret_type=none_type(), + lookup_fun=CallFun, result_action=FinalFun} + end. + +-spec state__cfg(#state{}) -> cfg(). + +state__cfg(#state{cfg=Cfg}) -> + Cfg. + +-spec state__bb(#state{}, label()) -> bb(). + +state__bb(#state{cfg=Cfg}, Label) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + true = hipe_bb:is_bb(BB), % Just an assert + BB. + +-spec state__bb_add(#state{}, label(), bb()) -> #state{}. + +state__bb_add(S=#state{cfg=Cfg}, Label, BB) -> + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), + S#state{cfg=NewCfg}. + +state__lookup_fun(#state{lookup_fun=LF}) -> LF. + +state__result_action(#state{result_action=RA}) -> RA. + +state__ret_type(#state{ret_type=RT}) -> RT. + +state__ret_type_update(#state{ret_type=RT} = State, NewType) -> + TotType = sup(RT, NewType), + State#state{ret_type=TotType}. + +state__info_in(S, Label) -> + state__info(S, {Label, in}). + +state__info(#state{info_map=IM}, Key) -> + gb_trees:get(Key, IM). + +state__update_info(State, LabelInfo, Rewrite) -> + update_info(LabelInfo, State, [], Rewrite). + +update_info([{Label,InfoIn}|Rest], State, LabelAcc, Rewrite) -> + case state__info_in_update(State, Label, InfoIn) of + fixpoint -> + if Rewrite -> + update_info(Rest, State, [Label|LabelAcc], Rewrite); + true -> + update_info(Rest, State, LabelAcc, Rewrite) + end; + NewState -> + update_info(Rest, NewState, [Label|LabelAcc], Rewrite) + end; +update_info([], State, LabelAcc, _Rewrite) -> + {State, LabelAcc}. + +state__info_in_update(S=#state{info_map=IM,liveness=Liveness}, Label, Info) -> + LabelIn = {Label, in}, + case gb_trees:lookup(LabelIn, IM) of + none -> + LiveIn = hipe_icode_ssa:ssa_liveness__livein(Liveness, Label), + NamesLiveIn = [hipe_icode:var_name(Var) || Var <- LiveIn, + hipe_icode:is_var(Var)], + OldInfo = gb_trees:empty(), + case join_info_in(NamesLiveIn, OldInfo, Info) of + fixpoint -> + S#state{info_map=gb_trees:insert(LabelIn, OldInfo, IM)}; + NewInfo -> + S#state{info_map=gb_trees:enter(LabelIn, NewInfo, IM)} + end; + {value, OldInfo} -> + OldVars = gb_trees:keys(OldInfo), + case join_info_in(OldVars, OldInfo, Info) of + fixpoint -> + fixpoint; + NewInfo -> + S#state{info_map=gb_trees:update(LabelIn, NewInfo, IM)} + end + end. + +join_info_in(Vars, OldInfo, NewInfo) -> + case join_info_in(Vars, OldInfo, NewInfo, gb_trees:empty(), false) of + {Res, true} -> Res; + {_, false} -> fixpoint + end. + +join_info_in([Var|Left], Info1, Info2, Acc, Changed) -> + Type1 = gb_trees:lookup(Var, Info1), + Type2 = gb_trees:lookup(Var, Info2), + case {Type1, Type2} of + {none, none} -> + NewTree = gb_trees:insert(Var, none_type(), Acc), + join_info_in(Left, Info1, Info2, NewTree, true); + {none, {value, Val}} -> + NewTree = gb_trees:insert(Var, Val, Acc), + join_info_in(Left, Info1, Info2, NewTree, true); + {{value, Val}, none} -> + NewTree = gb_trees:insert(Var, Val, Acc), + join_info_in(Left, Info1, Info2, NewTree, Changed); + {{value, Val}, {value, Val}} -> + NewTree = gb_trees:insert(Var, Val, Acc), + join_info_in(Left, Info1, Info2, NewTree, Changed); + {{value, Val1}, {value, Val2}} -> + NewVal = + case sup(Val1, Val2) of + Val1 -> + NewChanged = Changed, + Val1; + Val -> + NewChanged = true, + Val + end, + NewTree = gb_trees:insert(Var, NewVal, Acc), + join_info_in(Left, Info1, Info2, NewTree, NewChanged) + end; +join_info_in([], _Info1, _Info2, Acc, NewChanged) -> + {Acc, NewChanged}. + +enter_defines([Def|Rest], Info) -> + enter_defines(Rest, enter_define(Def, Info)); +enter_defines([], Info) -> Info. + +enter_define({PossibleVar, Range = #range{}}, Info) -> + case hipe_icode:is_var(PossibleVar) of + true -> + gb_trees:enter(hipe_icode:var_name(PossibleVar), Range, Info); + false -> + Info + end; +enter_define(PossibleVar, Info) -> + case hipe_icode:is_var(PossibleVar) of + true -> + case hipe_icode:variable_annotation(PossibleVar) of + {range_anno, #ann{range=Range}, _} -> + gb_trees:enter(hipe_icode:var_name(PossibleVar), Range, Info); + _ -> + Info + end; + false -> + Info + end. + +enter_vals(Ins, Info) -> + NewInfo = enter_defines(hipe_icode:args(Ins), Info), + enter_defines(hipe_icode:defines(Ins), NewInfo). + +lookup(PossibleVar, Info) -> + case hipe_icode:is_var(PossibleVar) of + true -> + case gb_trees:lookup(hipe_icode:var_name(PossibleVar), Info) of + none -> + none_type(); + {value, Val} -> + Val + end; + false -> + none_type() + end. + +%% _________________________________________________________________ +%% +%% The worklist. +%% + +init_work(State) -> + %% Labels = hipe_icode_cfg:reverse_postorder(state__cfg(State)), + Labels = [hipe_icode_cfg:start_label(state__cfg(State))], + {Labels, [], sets:from_list(Labels)}. + +get_work({[Label|Left], List, Set}) -> + NewWork = {Left, List, sets:del_element(Label, Set)}, + {Label, NewWork}; +get_work({[], [], _Set}) -> + fixpoint; +get_work({[], List, Set}) -> + get_work({lists:reverse(List), [], Set}). + +add_work(Work = {List1, List2, Set}, [Label|Left]) -> + case sets:is_element(Label, Set) of + true -> + add_work(Work, Left); + false -> + %% io:format("Adding work: ~w\n", [Label]), + add_work({List1, [Label|List2], sets:add_element(Label, Set)}, Left) + end; +add_work(Work, []) -> + Work. + +convert_cfg_to_types(Cfg) -> + Lbls = hipe_icode_cfg:reverse_postorder(Cfg), + lists:foldl(fun convert_lbl_to_type/2, Cfg, Lbls). + +convert_lbl_to_type(Lbl, Cfg) -> + BB = hipe_icode_cfg:bb(Cfg, Lbl), + Code = hipe_bb:code(BB), + NewCode = [convert_instr_to_type(I) || I <- Code], + hipe_icode_cfg:bb_add(Cfg, Lbl, hipe_bb:mk_bb(NewCode)). + +convert_instr_to_type(I) -> + Uses = hipe_icode:uses(I), + UseSubstList = [{Use, convert_to_types(Use)} || + Use <- Uses, hipe_icode:is_annotated_variable(Use)], + NewI = hipe_icode:subst_uses(UseSubstList, I), + Defs = hipe_icode:defines(NewI), + DefSubstList = [{Def, convert_to_types(Def)} || + Def <- Defs, hipe_icode:is_annotated_variable(Def)], + hipe_icode:subst_defines(DefSubstList, NewI). + +convert_to_types(VarOrReg) -> + Annotation = + case hipe_icode:variable_annotation(VarOrReg) of + {range_anno, Ann, _} -> + {type_anno, convert_ann_to_types(Ann), fun erl_types:t_to_string/1}; + {type_anno, _, _} = TypeAnn -> + TypeAnn + end, + hipe_icode:annotate_variable(VarOrReg, Annotation). + +convert_ann_to_types(#ann{range=#range{range={Min,Max}, other=false}}) -> + t_from_range_unsafe(Min, Max); +convert_ann_to_types(#ann{range=#range{range=empty, other=false}}) -> + t_none(); +convert_ann_to_types(#ann{range=#range{other=true}, type=Type}) -> + Type. + +%%===================================================================== +%% Icode Coordinator Callbacks +%%===================================================================== + +-spec replace_nones([#range{}]) -> [#range{}]. +replace_nones(Args) -> + [replace_none(Arg) || Arg <- Args]. + +replace_none(Arg) -> + case range__is_none(Arg) of + true -> any_type(); + false -> Arg + end. + +-spec update__info([#range{}], [#range{}]) -> {boolean(), [#ann{}]}. +update__info(NewRanges, OldRanges) -> + SupFun = fun (Ann, Range) -> + join_info(Ann, Range, fun safe_widen/3) + end, + EqFun = fun (X, Y) -> X =:= Y end, + ResRanges = lists:zipwith(SupFun, OldRanges, NewRanges), + Change = lists:zipwith(EqFun, ResRanges, OldRanges), + {lists:all(fun (X) -> X end, Change), ResRanges}. + +-spec new__info/1 :: ([#range{}]) -> [#ann{}]. +new__info(NewRanges) -> + [#ann{range=Range,count=1,type=t_any()} || Range <- NewRanges]. + +-spec return__info/1 :: ([#ann{}]) -> [#range{}]. +return__info(Ranges) -> + [Range || #ann{range=Range} <- Ranges]. + +-spec return_none/0 :: () -> [#range{},...]. +return_none() -> + [none_type()]. + +-spec return_none_args/2 :: (#cfg{}, mfa()) -> [#range{}]. +return_none_args(Cfg, {_M,_F,A}) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg) + 1; + false -> A + end, + lists:duplicate(NoArgs, none_type()). + +-spec return_any_args/2 :: (#cfg{}, mfa()) -> [#range{}]. +return_any_args(Cfg, {_M,_F,A}) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg) + 1; + false -> A + end, + lists:duplicate(NoArgs, any_type()). + +%%===================================================================== + +next_up_limit(X) when is_integer(X), X < 0 -> 0; +next_up_limit(X) when is_integer(X), X < 255 -> 255; +next_up_limit(X) when is_integer(X), X < 16#10ffff -> 16#10ffff; +next_up_limit(X) when is_integer(X), X < 16#7ffffff -> 16#7ffffff; +next_up_limit(X) when is_integer(X), X < 16#7fffffff -> 16#7fffffff; +next_up_limit(X) when is_integer(X), X < 16#ffffffff -> 16#ffffffff; +next_up_limit(X) when is_integer(X), X < 16#fffffffffff -> 16#fffffffffff; +next_up_limit(X) when is_integer(X), X < 16#7fffffffffffffff -> 16#7fffffffffffffff; +next_up_limit(_X) -> pos_inf. + +next_down_limit(X) when is_integer(X), X > 0 -> 0; +next_down_limit(X) when is_integer(X), X > -256 -> -256; +next_down_limit(X) when is_integer(X), X > -16#10ffff -> -16#10ffff; +next_down_limit(X) when is_integer(X), X > -16#8000000 -> -16#8000000; +next_down_limit(X) when is_integer(X), X > -16#80000000 -> -16#80000000; +next_down_limit(X) when is_integer(X), X > -16#800000000000000 -> -16#800000000000000; +next_down_limit(_X) -> neg_inf. diff --git a/lib/hipe/icode/hipe_icode_split_arith.erl b/lib/hipe/icode/hipe_icode_split_arith.erl new file mode 100644 index 0000000000..d59f9247fa --- /dev/null +++ b/lib/hipe/icode/hipe_icode_split_arith.erl @@ -0,0 +1,553 @@ +%% -*- 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_icode_split_arith.erl +%% Author : Tobias Lindahl +%% Description : +%% +%% Created : 12 Nov 2003 by Tobias Lindahl +%%------------------------------------------------------------------- +-module(hipe_icode_split_arith). + +-export([cfg/3]). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +-define(MIN_RATIO, 0.005). + +%%------------------------------------------------------------------- + +-spec cfg(#cfg{}, mfa(), comp_options()) -> #cfg{}. + +cfg(Cfg, _MFA, Options) -> + Icode = hipe_icode_cfg:cfg_to_linear(Cfg), + case proplists:get_bool(split_arith_unsafe, Options) of + true -> make_split_unsafe(Icode); + _ -> + case preprocess(Icode) of + {do_not_split, _Ratio} -> + Cfg; + {split, _Ratio, Icode1} -> + NewCfg = split(Icode1), + %% hipe_icode_cfg:pp(NewCfg), + NewCfg + end + end. + +check_nofix_const([Arg1|Arg2]) -> + case hipe_icode:is_const(Arg1) of + true -> + Val1 = hipe_tagscheme:fixnum_val(hipe_icode:const_value(Arg1)), + case hipe_tagscheme:is_fixnum(Val1) of + true -> + check_nofix_const(Arg2); + false -> {no} + end; + false -> + check_nofix_const(Arg2) + end; +check_nofix_const([]) -> true. + +check_const([I|Left]) -> + case I of + #icode_call{} -> + case is_arith(I) of + true -> + Args = hipe_icode:call_args(I), + case check_nofix_const(Args) of + {no} -> {do_not_split}; + _ -> check_const(Left) + end; + _ -> check_const(Left) + end; + _ -> check_const(Left) + end; +check_const([]) -> {yes}. + +make_split_unsafe(Icode) -> + LinearCode = hipe_icode:icode_code(Icode), + NewLinearCode = change_unsafe(LinearCode), + NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode), + hipe_icode_cfg:linear_to_cfg(NewIcode). + +change_unsafe([I|Is]) -> + case I of + #icode_call{} -> + case is_arith_extra_unsafe(I) of + true -> + NewOp = arithop_to_extra_unsafe(hipe_icode:call_fun(I)), + NewI1 = hipe_icode:call_fun_update(I, NewOp), + [NewI1|change_unsafe(Is)]; + false -> + [I|change_unsafe(Is)] + end; + _ -> + [I|change_unsafe(Is)] + end; +change_unsafe([]) -> []. + +preprocess(Icode) -> + LinearCode = hipe_icode:icode_code(Icode), + case check_const(LinearCode) of + {do_not_split} -> %%io:format("NO FIXNUM....."), + {do_not_split, 1.9849}; % Ratio val is ignored + _ -> + {NofArith, NofIns, NewLinearCode} = preprocess_code(LinearCode), + case NofArith / NofIns of + X when X >= ?MIN_RATIO -> + NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode), + {split, X, NewIcode}; + Y -> + {do_not_split, Y} + end + end. + +preprocess_code([H|Code]) -> + preprocess_code(Code, 0, 0, [H]). + +preprocess_code([I|Left], NofArith, NofIns, CodeAcc = [PrevI|_]) -> + case I of + #icode_call{} -> + case is_arith(I) of + true -> + %% Note that we need to put these instructions in a separate + %% basic block since we need the ability to fail to these + %% instructions, but also fail from them. The basic block + %% merger will take care of unnecessary splits. + + %% If call is an arithmetic operation replace the operation + %% with the specified replacement operator. + NewOp = arithop_to_split(hipe_icode:call_fun(I)), + NewI = hipe_icode:call_fun_update(I, NewOp), + case hipe_icode:is_label(PrevI) of + true -> + case (Left =:= []) orelse hipe_icode:is_label(hd(Left)) of + true -> + preprocess_code(Left, NofArith+1, NofIns+1, [NewI|CodeAcc]); + false -> + NewLabel = hipe_icode:mk_new_label(), + NewLabelName = hipe_icode:label_name(NewLabel), + NewI1 = hipe_icode:call_set_continuation(NewI, NewLabelName), + preprocess_code(Left, NofArith+1, NofIns+1, + [NewLabel, NewI1|CodeAcc]) + end; + false -> + RevPreCode = + case hipe_icode:is_branch(PrevI) of + true -> + [hipe_icode:mk_new_label()]; + false -> + NewLabel1 = hipe_icode:mk_new_label(), + NewLabelName1 = hipe_icode:label_name(NewLabel1), + [NewLabel1, hipe_icode:mk_goto(NewLabelName1)] + end, + case (Left =:= []) orelse hipe_icode:is_label(hd(Left)) of + true -> + preprocess_code(Left, NofArith+1, NofIns+1, + [NewI|RevPreCode] ++ CodeAcc); + false -> + NewLabel2 = hipe_icode:mk_new_label(), + NewLabelName2 = hipe_icode:label_name(NewLabel2), + NewI1 = hipe_icode:call_set_continuation(NewI, NewLabelName2), + preprocess_code(Left, NofArith+1, NofIns+1, + [NewLabel2, NewI1|RevPreCode] ++ CodeAcc) + end + end; + false -> + preprocess_code(Left, NofArith, NofIns + 1, [I|CodeAcc]) + end; + #icode_label{} -> + %% Don't count labels as instructions. + preprocess_code(Left, NofArith, NofIns, [I|CodeAcc]); + _ -> + preprocess_code(Left, NofArith, NofIns+1, [I|CodeAcc]) + end; +preprocess_code([], NofArith, NofIns, CodeAcc) -> + {NofArith, NofIns, lists:reverse(CodeAcc)}. + +split(Icode) -> + LinearCode = hipe_icode:icode_code(Icode), + %% create a new icode label for each existing icode label + %% create mappings, NewToOld and OldToNew. + AllLabels = lists:foldl(fun(I, Acc) -> + case hipe_icode:is_label(I) of + true -> [hipe_icode:label_name(I)|Acc]; + false -> Acc + end + end, [], LinearCode), + {OldToNewMap, NewToOldMap} = new_label_maps(AllLabels), + + %% the call below doubles the number of basic blocks with the new + %% labels instead of the old. + + NewLinearCode = map_code(LinearCode, OldToNewMap), + NewIcode = hipe_icode:icode_code_update(Icode, NewLinearCode), + NewCfg = hipe_icode_cfg:linear_to_cfg(NewIcode), + NewCfg2 = + insert_tests(NewCfg, [gb_trees:get(X, OldToNewMap) || X<-AllLabels], + NewToOldMap, OldToNewMap), + %% io:format("split(Cfg): Inserting testsL Done\n", []), + NewCfg2. + +map_code(OldCode, LabelMap) -> + AddedCode = map_code(OldCode, none, LabelMap, []), + OldCode ++ AddedCode. + +map_code([I|Left], ArithFail, LabelMap, Acc) -> + case I of + #icode_call{} -> + case is_arith(I) of + true -> + case hipe_icode:defines(I) of + []-> + map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc]); + _ -> + NewOp = split_to_unsafe(I), + NewI1 = hipe_icode:call_fun_update(I, NewOp), + NewI2 = redirect(NewI1, LabelMap), + NewI3 = hipe_icode:call_set_fail_label(NewI2, ArithFail), + map_code(Left, ArithFail, LabelMap, [NewI3|Acc]) + end; + false -> + map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc]) + end; + #icode_label{} -> + LabelName = hipe_icode:label_name(I), + NewLabel = hipe_icode:mk_label(gb_trees:get(LabelName, LabelMap)), + map_code(Left, LabelName, LabelMap, [NewLabel|Acc]); + _ -> + map_code(Left, ArithFail, LabelMap, [redirect(I, LabelMap)|Acc]) + end; +map_code([], _ArithFail, _LabelMap, Acc) -> + lists:reverse(Acc). + +insert_tests(Cfg, Labels,NewToOldMap, OldToNewMap) -> + InfoMap = infomap_init(Labels), + %%io:format("insert_tests/3: Finding testpoints ...\n", []), + NewInfoMap = find_testpoints(Cfg, Labels, InfoMap), + %%io:format("insert_tests/3: Finding testpoints: Done\n", []), + %%io:format("insert_tests/3: Infomap: ~w\n", [gb_trees:to_list(NewInfoMap)]), + make_tests(Cfg, NewInfoMap, NewToOldMap, OldToNewMap). + +find_testpoints(Cfg, Labels, InfoMap) -> + case find_testpoints(Labels, InfoMap, Cfg, false) of + {dirty, NewInfoMap} -> + %%io:format("find_testpoints/3: Looping\n", []), + find_testpoints(Cfg, Labels, NewInfoMap); + fixpoint -> + InfoMap + end. + +find_testpoints([Lbl|Left], InfoMap, Cfg, Dirty) -> + Code = hipe_bb:code(hipe_icode_cfg:bb(Cfg, Lbl)), + InfoOut = join_info(hipe_icode_cfg:succ(Cfg, Lbl), InfoMap), + OldInfoIn = infomap_get_all(Lbl, InfoMap), + NewInfoIn = traverse_code(lists:reverse(Code), InfoOut), + case (gb_sets:is_subset(OldInfoIn, NewInfoIn) andalso + gb_sets:is_subset(NewInfoIn, OldInfoIn)) of + true -> + find_testpoints(Left, InfoMap, Cfg, Dirty); + false -> + %%io:format("find_testpoints/4: Label: ~w: OldMap ~w\nNewMap: ~w\n", + %% [Lbl, gb_sets:to_list(OldInfoIn), gb_sets:to_list(NewInfoIn)]), + NewInfoMap = gb_trees:update(Lbl, NewInfoIn, InfoMap), + find_testpoints(Left, NewInfoMap, Cfg, true) + end; +find_testpoints([], InfoMap, _Cfg, Dirty) -> + if Dirty -> {dirty, InfoMap}; + true -> fixpoint + end. + +traverse_code([I|Left], Info) -> + NewInfo = kill_defines(I, Info), + case I of + #icode_call{} -> + case is_unsafe_arith(I) of + true -> + %% The dst is sure to be a fixnum. Remove the 'killed' mark. + Dst = hd(hipe_icode:call_dstlist(I)), + NewInfo1 = gb_sets:delete_any({killed, Dst}, NewInfo), + NewInfo2 = + gb_sets:union(NewInfo1, gb_sets:from_list(hipe_icode:uses(I))), + traverse_code(Left, NewInfo2); + false -> + traverse_code(Left, NewInfo) + end; + #icode_move{} -> + Dst = hipe_icode:move_dst(I), + case gb_sets:is_member(Dst, Info) of + true -> + %% The dst is an argument to an arith op. Transfer the test + %% to the src and remove the 'killed' mark from the dst. + NewInfo1 = gb_sets:delete({killed, Dst}, NewInfo), + Src = hipe_icode:move_src(I), + case hipe_icode:is_const(Src) of + true -> + traverse_code(Left, NewInfo1); + false -> + NewInfo2 = gb_sets:add(Src, NewInfo1), + traverse_code(Left, NewInfo2) + end; + false -> + traverse_code(Left, NewInfo) + end; + _ -> + traverse_code(Left, NewInfo) + end; +traverse_code([], Info) -> + Info. + +kill_defines(I, Info) -> + Defines = hipe_icode:defines(I), + case [X || X<-Defines, gb_sets:is_member(X, Info)] of + [] -> + Info; + List -> + TmpInfo = gb_sets:difference(Info, gb_sets:from_list(List)), + gb_sets:union(gb_sets:from_list([{killed, X} || X <- List]), TmpInfo) + end. + +make_tests(Cfg, InfoMap, NewToOldMap, OldToNewMap) -> + %%io:format("make_tests 0:\n",[]), + WorkList = make_worklist(gb_trees:keys(NewToOldMap), InfoMap, + NewToOldMap, Cfg, []), + %%io:format("make_tests 1:Worklist: ~w\n",[WorkList]), + NewCfg = make_tests(WorkList, Cfg), + %%io:format("make_tests 2\n",[]), + %% If the arguments to this function are used in unsafe arith + %% they should be marked as killed by a new start block. + Args = hipe_icode_cfg:params(NewCfg), + Start = hipe_icode_cfg:start_label(NewCfg), + AltStart = gb_trees:get(Start, OldToNewMap), + UnsafeIn = gb_sets:to_list(infomap_get(AltStart, InfoMap)), + case [X || X <- UnsafeIn, Y <- Args, X =:= Y] of + [] -> + hipe_icode_cfg:start_label_update(NewCfg, AltStart); + KilledArgs -> + NewStart = hipe_icode:label_name(hipe_icode:mk_new_label()), + NewCfg1 = insert_test_block(NewStart, AltStart, Start, + KilledArgs, NewCfg), + hipe_icode_cfg:start_label_update(NewCfg1, NewStart) + end. + +make_worklist([Lbl|Left], InfoMap, LabelMap, Cfg, Acc) -> + Vars = infomap_get_killed(Lbl, InfoMap), + case gb_sets:is_empty(Vars) of + true -> make_worklist(Left, InfoMap, LabelMap, Cfg, Acc); + false -> + %% io:format("make_worklist 1 ~w\n", [Vars]), + NewAcc0 = + [{Lbl, Succ, gb_trees:get(Succ, LabelMap), + gb_sets:intersection(infomap_get(Succ, InfoMap), Vars)} + || Succ <- hipe_icode_cfg:succ(Cfg, Lbl)], + NewAcc = [{Label, Succ, FailLbl, gb_sets:to_list(PrunedVars)} + || {Label, Succ, FailLbl, PrunedVars} <- NewAcc0, + gb_sets:is_empty(PrunedVars) =:= false] ++ Acc, + %% io:format("make_worklist 2\n", []), + make_worklist(Left, InfoMap, LabelMap, Cfg, NewAcc) + end; +make_worklist([], _InfoMap, _LabelMap, _Cfg, Acc) -> + Acc. + +make_tests([{FromLbl, ToLbl, FailLbl, Vars}|Left], Cfg) -> + NewLbl = hipe_icode:label_name(hipe_icode:mk_new_label()), + TmpCfg = insert_test_block(NewLbl, ToLbl, FailLbl, Vars, Cfg), + NewCfg = hipe_icode_cfg:redirect(TmpCfg, FromLbl, ToLbl, NewLbl), + make_tests(Left, NewCfg); +make_tests([], Cfg) -> + Cfg. + +insert_test_block(NewLbl, Succ, FailLbl, Vars, Cfg) -> + Code = [hipe_icode:mk_type(Vars, fixnum, Succ, FailLbl, 0.99)], + BB = hipe_bb:mk_bb(Code), + hipe_icode_cfg:bb_add(Cfg, NewLbl, BB). + +infomap_init(Labels) -> + infomap_init(Labels, gb_trees:empty()). + +infomap_init([Lbl|Left], Map) -> + infomap_init(Left, gb_trees:insert(Lbl, gb_sets:empty(), Map)); +infomap_init([], Map) -> + Map. + +join_info(Labels, Map) -> + join_info(Labels, Map, gb_sets:empty()). + +join_info([Lbl|Left], Map, Set) -> + join_info(Left, Map, gb_sets:union(Set, infomap_get(Lbl, Map))); +join_info([], _Map, Set) -> + Set. + +infomap_get(Lbl, Map) -> + case gb_trees:lookup(Lbl, Map) of + none -> gb_sets:empty(); + {value, Val} -> + gb_sets:filter(fun(X) -> case X of + {killed, _} -> false; + _ -> true + end + end, + Val) + end. + +infomap_get_all(Lbl, Map) -> + case gb_trees:lookup(Lbl, Map) of + none -> gb_sets:empty(); + {value, Val} -> Val + end. + +infomap_get_killed(Lbl, Map) -> + case gb_trees:lookup(Lbl, Map) of + none -> gb_sets:empty(); + {value, Val} -> + Fun = fun(X, Acc) -> + case X of + {killed, Var} -> [Var|Acc]; + _ -> Acc + end + end, + gb_sets:from_list(lists:foldl(Fun, [], gb_sets:to_list(Val))) + end. + +%%%------------------------------------------------------------------- +%%% General replace of '+'/'-' to super safe version + +arithop_to_split(Op) -> + case Op of + '+' -> gen_add; + '-' -> gen_sub; + _ -> Op + end. + +%%%------------------------------------------------------------------- +%%% Check if it's an arith op that needs to be split + +is_arith(I) -> + case hipe_icode:call_fun(I) of + '+' -> true; + '-' -> true; + gen_add -> true; + gen_sub -> true; + 'bor' -> true; + 'bxor' -> true; + 'bsr' -> + %% Need to check that the second argument is a non-negative + %% fixnum. We only allow for constants to simplify things. + [_, Arg2] = hipe_icode:args(I), + hipe_icode:is_const(Arg2) andalso (hipe_icode:const_value(Arg2) >= 0); + 'bsl' -> + %% There are major issues with bsl since it doesn't flag + %% overflow. We cannot allow for this in this optimization pass. + false; + 'bnot' -> true; + 'band' -> true; + _ -> false + end. + +%%%------------------------------------------------------------------- + +is_unsafe_arith(I) -> + case hipe_icode:call_fun(I) of + unsafe_add -> true; + unsafe_sub -> true; + unsafe_bor -> true; + unsafe_bxor -> true; + unsafe_bsr -> true; + unsafe_bsl -> true; + unsafe_bnot -> true; + unsafe_band -> true; + _ -> false + end. + +split_to_unsafe(I) -> + case hipe_icode:call_fun(I) of + gen_add -> unsafe_add; + gen_sub -> unsafe_sub; + 'bor' -> unsafe_bor; + 'bxor' -> unsafe_bxor; + 'bsr' -> + case is_arith(I) of + true -> unsafe_bsr; + false -> 'bsr' + end; + 'bsl' -> + %% There are major issues with bsl since it doesn't flag + %% overflow. We cannot allow for this in this optimization pass. + 'bsl'; + 'bnot' -> unsafe_bnot; + 'band' -> unsafe_band; + Op -> Op + end. + +%%%------------------------------------------------------------------- +%%% FLAG = split_arith_unsafe + +is_arith_extra_unsafe(I) -> + case hipe_icode:call_fun(I) of + '+' -> true; + '-' -> true; + 'bor' -> true; + 'bxor' -> true; + 'bsr' -> is_arith(I); + 'bsl' -> false; %% See comment in is_arith/1 + 'bnot' -> true; + 'band' -> true; + _ -> false + end. + +arithop_to_extra_unsafe(Op) -> + case Op of + '+' -> extra_unsafe_add; + '-' -> extra_unsafe_sub; + 'bor' -> unsafe_bor; + 'bxor' -> unsafe_bxor; + 'bsr' -> unsafe_bsr; + 'bsl' -> 'bsl'; %% See comment in split_to_unsafe/1 + 'bnot' -> unsafe_bnot; + 'band' -> unsafe_band + end. + +%%%------------------------------------------------------------------- + +redirect(I, LabelMap) -> + case hipe_icode:successors(I) of + [] -> I; + Successors -> + RedirectMap = [{X, gb_trees:get(X, LabelMap)} || X <- Successors], + redirect_1(RedirectMap, I) + end. + +redirect_1([{From, To}|Left], I) -> + redirect_1(Left, hipe_icode:redirect_jmp(I, From, To)); +redirect_1([], I) -> + I. + +new_label_maps(Labels) -> + new_label_maps(Labels, gb_trees:empty(), gb_trees:empty()). + +new_label_maps([Lbl|Left], Map1, Map2) -> + NewLabel = hipe_icode:label_name(hipe_icode:mk_new_label()), + NewMap1 = gb_trees:insert(Lbl, NewLabel, Map1), + NewMap2 = gb_trees:insert(NewLabel, Lbl, Map2), + new_label_maps(Left, NewMap1, NewMap2); +new_label_maps([], Map1, Map2) -> + {Map1, Map2}. diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl new file mode 100755 index 0000000000..719d5d8f45 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_ssa.erl @@ -0,0 +1,98 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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_icode_ssa.erl +%% Author : +%% Created : +%% Purpose : Provides interface functions for converting Icode into +%% SSA form and back using the generic SSA converter. +%%---------------------------------------------------------------------- + +-module(hipe_icode_ssa). + +%% The following defines are needed by the included file below +-define(CODE, hipe_icode). +-define(CFG, hipe_icode_cfg). +-define(LIVENESS, hipe_icode_liveness). +-define(LIVENESS_NEEDED, true). + +-include("hipe_icode.hrl"). +-include("../ssa/hipe_ssa.inc"). + +%% Declarations for exported functions which are Icode-specific. +-spec ssa_liveness__analyze(#cfg{}) -> gb_tree(). +-spec ssa_liveness__livein(_, icode_lbl()) -> [#icode_variable{}]. +%% -spec ssa_liveness__livein(_, icode_lbl(), _) -> [#icode_var{}]. + +%%---------------------------------------------------------------------- +%% Auxiliary operations which seriously differ between Icode and RTL. +%%---------------------------------------------------------------------- + +defs_to_rename(Statement) -> + hipe_icode:defines(Statement). + +uses_to_rename(Statement) -> + hipe_icode:uses(Statement). + +liveout_no_succ() -> + []. + +%%---------------------------------------------------------------------- + +reset_var_indx() -> + hipe_gensym:set_var(icode, 0). + +%%---------------------------------------------------------------------- + +is_fp_temp(Temp) -> + hipe_icode:is_fvar(Temp). + +mk_new_fp_temp() -> + hipe_icode:mk_new_fvar(). + +%%---------------------------------------------------------------------- +%% Procedure : makePhiMove +%% Purpose : Create an ICode-specific version of a move instruction +%% depending on the type of the arguments. +%% Arguments : Dst, Src - the arguments of a Phi instruction that is +%% to be moved up the predecessor block as part +%% of the SSA unconvert phase. +%% Returns : Code +%%---------------------------------------------------------------------- + +makePhiMove(Dst, Src) -> + case hipe_icode:is_fvar(Dst) of + false -> + case hipe_icode:is_fvar(Src) of + false -> + hipe_icode:mk_move(Dst, Src); + true -> + hipe_icode:mk_primop([Dst], unsafe_tag_float, [Src]) + end; + true -> + case hipe_icode:is_fvar(Src) of + true -> + hipe_icode:mk_move(Dst, Src); + false -> + hipe_icode:mk_primop([Dst], conv_to_float, [Src]) + end + end. + +%%---------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl new file mode 100644 index 0000000000..f1640b1cee --- /dev/null +++ b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl @@ -0,0 +1,728 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% ============================================================================ +%% Filename : hipe_icode_ssa_const_prop.erl +%% Authors : Daniel Luna, Erik Andersson +%% Purpose : Perform sparse conditional constant propagation on Icode. +%% Notes : Works on the control-flow graph. +%% +%% History : * 2003-03-05: Created. +%% * 2003-08-11: Passed simple testsuite. +%% * 2003-10-01: Passed compiler testsuite. +%% ============================================================================ +%% +%% Exports: propagate/1. +%% +%% ============================================================================ +%% +%% TODO: +%% +%% Take care of failures in call and replace operation with appropriate +%% failure. +%% +%% Handle ifs with non-binary operators +%% +%% We want multisets for easier (and faster) creation of env->ssa_edges +%% +%% Maybe do things with begin_handler, begin_try if possible +%% +%% Propagation of constant arguments when some of the arguments are bottom +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hipe_icode_ssa_const_prop). +-export([propagate/1]). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). +-include("hipe_icode_primops.hrl"). + +-define(CONST_PROP_MSG(Str,L), ok). +%%-define(CONST_PROP_MSG(Str,L), io:format(Str,L)). + +%%-define(DEBUG, 1). + +%%----------------------------------------------------------------------------- +%% Include stuff shared between SCCP on Icode and RTL. +%% NOTE: Needs to appear after DEBUG is possibly defined. +%%----------------------------------------------------------------------------- + +-define(CODE, hipe_icode). +-define(CFG, hipe_icode_cfg). + +-include("../ssa/hipe_ssa_const_prop.inc"). + +%%----------------------------------------------------------------------------- + +visit_expression(Instruction, Environment) -> + EvaluatedArguments = [lookup_lattice_value(Argument, Environment) + || Argument <- hipe_icode:args(Instruction)], + case Instruction of + #icode_move{} -> + visit_move (Instruction, EvaluatedArguments, Environment); + #icode_if{} -> + visit_if (Instruction, EvaluatedArguments, Environment); + #icode_goto{} -> + visit_goto (Instruction, EvaluatedArguments, Environment); + #icode_type{} -> + visit_type (Instruction, EvaluatedArguments, Environment); + #icode_call{} -> + visit_call (Instruction, EvaluatedArguments, Environment); + #icode_switch_val{} -> + visit_switch_val (Instruction, EvaluatedArguments, Environment); + #icode_switch_tuple_arity{} -> + visit_switch_tuple_arity(Instruction, EvaluatedArguments, Environment); + #icode_begin_handler{} -> + visit_begin_handler (Instruction, EvaluatedArguments, Environment); + #icode_begin_try{} -> + visit_begin_try (Instruction, EvaluatedArguments, Environment); + #icode_fail{} -> + visit_fail (Instruction, EvaluatedArguments, Environment); + _ -> + %% label, end_try, comment, return, + {[], [], Environment} + end. + +%%----------------------------------------------------------------------------- + +visit_begin_try(Instruction, [], Environment) -> + Label = hipe_icode:begin_try_label(Instruction), + Successor = hipe_icode:begin_try_successor(Instruction), + {[Label, Successor], [], Environment}. + +%%----------------------------------------------------------------------------- + +visit_begin_handler(Instruction, _Arguments, Environment) -> + Destinations = hipe_icode:begin_handler_dstlist(Instruction), + {Environment1, SSAWork} = + lists:foldl(fun (Dst, {Env0,Work0}) -> + {Env, Work} = update_lattice_value({Dst, bottom}, Env0), + {Env, Work ++ Work0} + end, + {Environment, []}, + Destinations), + {[], SSAWork, Environment1}. + +%%----------------------------------------------------------------------------- + +visit_switch_val(Instruction, [Argument], Environment) -> + Cases = hipe_icode:switch_val_cases(Instruction), + FailLabel = hipe_icode:switch_val_fail_label(Instruction), + case Argument of + bottom -> + FlowWork = [Label || {_Value, Label} <- Cases], + FlowWork1 = [FailLabel | FlowWork], + {FlowWork1, [], Environment}; + _ -> + Target = get_switch_target(Cases, Argument, FailLabel), + {[Target], [], Environment} + end. + +%%----------------------------------------------------------------------------- + +visit_switch_tuple_arity(Instruction, [Argument], Environment) -> + Cases = hipe_icode:switch_tuple_arity_cases(Instruction), + FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction), + case Argument of + bottom -> + FlowWork = [Label || {_Value, Label} <- Cases], + FlowWork1 = [FailLabel | FlowWork], + {FlowWork1, [], Environment}; + Constant -> + UnTagged = hipe_icode:const_value(Constant), + case is_tuple(UnTagged) of + true -> + Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel), + {[Target], [], Environment}; + false -> + {[FailLabel], [], Environment} + end + end. + +%%----------------------------------------------------------------------------- + +get_switch_target([], _Argument, FailLabel) -> + FailLabel; +get_switch_target([{CaseValue, Target} | CaseList], Argument, FailLabel) -> + case CaseValue =:= Argument of + true -> + Target; + false -> + get_switch_target(CaseList, Argument, FailLabel) + end. + +%%----------------------------------------------------------------------------- + +visit_move(Instruction, [SourceValue], Environment) -> + Destination = hipe_icode:move_dst(Instruction), + {Environment1, SSAWork} = update_lattice_value({Destination, SourceValue}, + Environment), + {[], SSAWork, Environment1}. + +%%----------------------------------------------------------------------------- + +visit_if(Instruction, Arguments, Environment) -> + FlowWork = + case evaluate_if(hipe_icode:if_op(Instruction), Arguments) of + true -> + TrueLabel = hipe_icode:if_true_label(Instruction), + [TrueLabel]; + false -> + FalseLabel = hipe_icode:if_false_label(Instruction), + [FalseLabel]; + bottom -> + TrueLabel = hipe_icode:if_true_label(Instruction), + FalseLabel = hipe_icode:if_false_label(Instruction), + [TrueLabel, FalseLabel] + end, + {FlowWork, [], Environment}. + +%%----------------------------------------------------------------------------- + +visit_goto(Instruction, _Arguments, Environment) -> + GotoLabel = hipe_icode:goto_label(Instruction), + FlowWork = [GotoLabel], + {FlowWork, [], Environment}. + +%%----------------------------------------------------------------------------- + +visit_fail(Instruction, _Arguments, Environment) -> + FlowWork = hipe_icode:successors(Instruction), + {FlowWork, [], Environment}. + +%%----------------------------------------------------------------------------- + +visit_type(Instruction, Values, Environment) -> + FlowWork = + case evaluate_type(hipe_icode:type_test(Instruction), Values) of + true -> + TrueLabel = hipe_icode:type_true_label(Instruction), + [TrueLabel]; + false -> + FalseLabel = hipe_icode:type_false_label(Instruction), + [FalseLabel]; + bottom -> + TrueLabel = hipe_icode:type_true_label(Instruction), + FalseLabel = hipe_icode:type_false_label(Instruction), + [TrueLabel, FalseLabel] + end, + {FlowWork, [], Environment}. + +%%----------------------------------------------------------------------------- + +visit_call(Ins, Args, Environment) -> + Dsts = hipe_icode:call_dstlist(Ins), + Fun = hipe_icode:call_fun(Ins), + Fail = call_fail_labels(Ins), + Cont = call_continuation_labels(Ins), + visit_call(Dsts, Args, Fun, Cont, Fail, Environment). + +visit_call(Dst, Args, Fun, Cont, Fail, Environment) -> + {FlowWork, {Environment1, SSAWork}} = + case lists:any(fun(X) -> (X =:= bottom) end, Args) of + true -> + {Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)}; + false -> + ConstArgs = [hipe_icode:const_value(Argument) || Argument <- Args], + try evaluate_call_or_enter(ConstArgs, Fun) of + bottom -> + {Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)}; + Constant -> + {Cont, update_lattice_value({Dst, Constant}, Environment)} + catch + _:_ -> + {Fail, update_lattice_value({Dst, bottom}, Environment)} + end + end, + {FlowWork, SSAWork, Environment1}. + +%%----------------------------------------------------------------------------- + +call_fail_labels(I) -> + case hipe_icode:call_fail_label(I) of + [] -> []; + Label -> [Label] + end. + +call_continuation_labels(I) -> + case hipe_icode:call_continuation(I) of + [] -> []; + Label -> [Label] + end. + +%%----------------------------------------------------------------------------- + +%% Unary calls +evaluate_call_or_enter([Argument], Fun) -> + case Fun of + mktuple -> + hipe_icode:mk_const(list_to_tuple([Argument])); + unsafe_untag_float -> + hipe_icode:mk_const(float(Argument)); + conv_to_float -> + hipe_icode:mk_const(float(Argument)); + fnegate -> + hipe_icode:mk_const(0.0 - Argument); + 'bnot' -> + hipe_icode:mk_const(Argument); + #unsafe_element{index=N} -> + hipe_icode:mk_const(element(N, Argument)); + {erlang, hd, 1} -> + hipe_icode:mk_const(hd(Argument)); + {erlang, tl, 1} -> + hipe_icode:mk_const(tl(Argument)); + {erlang, atom_to_list, 1} -> + hipe_icode:mk_const(atom_to_list(Argument)); + {erlang, list_to_atom, 1} -> + hipe_icode:mk_const(list_to_atom(Argument)); + {erlang, tuple_to_list, 1} -> + hipe_icode:mk_const(tuple_to_list(Argument)); + {erlang, list_to_tuple, 1} -> + hipe_icode:mk_const(list_to_tuple(Argument)); + {erlang, length, 1} -> + hipe_icode:mk_const(length(Argument)); + {erlang, size, 1} -> + hipe_icode:mk_const(size(Argument)); + {erlang, bit_size, 1} -> + hipe_icode:mk_const(bit_size(Argument)); + {erlang, byte_size, 1} -> + hipe_icode:mk_const(byte_size(Argument)); + {erlang, tuple_size, 1} -> + hipe_icode:mk_const(tuple_size(Argument)); + {erlang, abs, 1} -> + hipe_icode:mk_const(abs(Argument)); + {erlang, round, 1} -> + hipe_icode:mk_const(round(Argument)); + {erlang, trunc, 1} -> + hipe_icode:mk_const(trunc(Argument)); + _ -> + bottom + end; +%% Binary calls +evaluate_call_or_enter([Argument1,Argument2], Fun) -> + case Fun of + '+' -> + hipe_icode:mk_const(Argument1 + Argument2); + '-' -> + hipe_icode:mk_const(Argument1 - Argument2); + '*' -> + hipe_icode:mk_const(Argument1 * Argument2); + '/' -> + hipe_icode:mk_const(Argument1 / Argument2); + 'band' -> + hipe_icode:mk_const(Argument1 band Argument2); + 'bor' -> + hipe_icode:mk_const(Argument1 bor Argument2); + 'bsl' -> + hipe_icode:mk_const(Argument1 bsl Argument2); + 'bsr' -> + hipe_icode:mk_const(Argument1 bsr Argument2); + 'bxor' -> + hipe_icode:mk_const(Argument1 bxor Argument2); + fp_add -> + hipe_icode:mk_const(float(Argument1 + Argument2)); + fp_sub -> + hipe_icode:mk_const(float(Argument1 - Argument2)); + fp_mul -> + hipe_icode:mk_const(float(Argument1 * Argument2)); + fp_div -> + hipe_icode:mk_const(Argument1 / Argument2); + cons -> + hipe_icode:mk_const([Argument1 | Argument2]); + mktuple -> + hipe_icode:mk_const(list_to_tuple([Argument1,Argument2])); + #unsafe_update_element{index=N} -> + hipe_icode:mk_const(setelement(N, Argument1, Argument2)); + {erlang, '++', 2} -> + hipe_icode:mk_const(Argument1 ++ Argument2); + {erlang, '--', 2} -> + hipe_icode:mk_const(Argument1 -- Argument2); + {erlang, 'div', 2} -> + hipe_icode:mk_const(Argument1 div Argument2); + {erlang, 'rem', 2} -> + hipe_icode:mk_const(Argument1 rem Argument2); + {erlang, append_element, 2} -> + hipe_icode:mk_const(erlang:append_element(Argument1, Argument2)); + {erlang, element, 2} -> + hipe_icode:mk_const(element(Argument1, Argument2)); + _Other -> + %% io:format("In ~w(~w,~w)~n", [_Other,Argument1,Argument2]), + bottom + end; + +%% The rest of the calls +evaluate_call_or_enter(Arguments, Fun) -> + case Fun of + mktuple -> + hipe_icode:mk_const(list_to_tuple(Arguments)); + {erlang, setelement, 3} -> + [Argument1, Argument2, Argument3] = Arguments, + hipe_icode:mk_const(setelement(Argument1, Argument2, Argument3)); + _ -> + bottom + end. + +%%----------------------------------------------------------------------------- + +evaluate_if(Conditional, [Argument1, Argument2]) -> + case ((Argument1 =:= bottom) or (Argument2 =:= bottom)) of + true -> bottom; + false -> evaluate_if_const(Conditional, Argument1, Argument2) + end; +evaluate_if(_Conditional, _Arguments) -> + bottom. + +%%----------------------------------------------------------------------------- + +evaluate_if_const(Conditional, Argument1, Argument2) -> + case Conditional of + '=:=' -> Argument1 =:= Argument2; + '==' -> Argument1 == Argument2; + '=/=' -> Argument1 =/= Argument2; + '/=' -> Argument1 /= Argument2; + '<' -> Argument1 < Argument2; + '>=' -> Argument1 >= Argument2; + '=<' -> Argument1 =< Argument2; + '>' -> Argument1 > Argument2; + _ -> bottom + end. + +%%----------------------------------------------------------------------------- + +evaluate_type(Type, Vals) -> + case [X || X <- Vals, X =:= bottom] of + [] -> evaluate_type_const(Type, Vals); + _ -> bottom + end. + +%%----------------------------------------------------------------------------- + +evaluate_type_const(Type, [Arg|Left]) -> + Test = + case {Type, hipe_icode:const_value(Arg)} of + {nil, [] } -> true; + {nil, _ } -> false; + {cons, [_|_]} -> true; + {cons, _ } -> false; + {{tuple, N}, T} when tuple_size(T) =:= N -> true; + {atom, A} when is_atom(A) -> true; + {{atom, A}, A} when is_atom(A) -> true; + {{record, A, S}, R} when tuple_size(R) =:= S, + element(1, R) =:= A -> true; + {{record, _, _}, _} -> false; + _ -> bottom + end, + case Test of + bottom -> bottom; + false -> false; + true -> evaluate_type_const(Type, Left) + end; +evaluate_type_const(_Type, []) -> + true. + +%%----------------------------------------------------------------------------- +%% Icode-specific code below +%%----------------------------------------------------------------------------- + +update_instruction(Instruction, Environment) -> + case Instruction of + #icode_call{} -> + update_call(Instruction, Environment); + #icode_enter{} -> + update_enter(Instruction, Environment); + #icode_if{} -> + update_if(Instruction, Environment); + #icode_move{} -> + update_move(Instruction, Environment); + #icode_phi{} -> + update_phi(Instruction, Environment); + #icode_switch_val{} -> + update_switch_val(Instruction, Environment); + #icode_type{} -> + update_type(Instruction, Environment); + #icode_switch_tuple_arity{} -> + update_switch_tuple_arity(Instruction, Environment); + _ -> + %% goto, comment, label, return, begin_handler, end_try, + %% begin_try, fail + %% We could but don't handle: catch?, fail? + [Instruction] + end. + +%%----------------------------------------------------------------------------- + +update_call(Instruction, Environment) -> + DestList = hipe_icode:call_dstlist(Instruction), + case DestList of + [Destination] -> + case lookup_lattice_value(Destination, Environment) of + bottom -> + NewArguments = update_arguments( + hipe_icode:call_args(Instruction), + Environment), + [hipe_icode:call_args_update(Instruction, NewArguments)]; + X -> + NewInstructions = + case is_call_to_fp_op(Instruction) of + true -> + TmpIns = + hipe_icode:call_fun_update(Instruction, unsafe_untag_float), + [hipe_icode:call_args_update(TmpIns, [X])]; + false -> + case hipe_icode:call_continuation(Instruction) of + [] -> + [hipe_icode:mk_move(Destination, X)]; + ContinuationLabel -> + [hipe_icode:mk_move(Destination, X), + hipe_icode:mk_goto(ContinuationLabel)] + end + end, + ?CONST_PROP_MSG("call: ~w ---> ~w\n", + [Instruction, NewInstructions]), + NewInstructions + end; +%% %% [] -> %% No destination; we don't touch this +%% [] -> +%% NewArguments = update_arguments(hipe_icode:call_args(Instruction), +%% Environment), +%% [hipe_icode:call_args_update(Instruction, NewArguments)]; + %% List-> %% Means register allocation; not implemented at this point + _ -> + [Instruction] + end. + +%%----------------------------------------------------------------------------- + +is_call_to_fp_op(Instruction) -> + case hipe_icode:call_fun(Instruction) of + fp_add -> true; + fp_sub -> true; + fp_mul -> true; + fp_div -> true; + fnegate -> true; + conv_to_float -> true; + unsafe_untag_float -> true; + _ -> false + end. + +%%----------------------------------------------------------------------------- + +update_enter(Instruction, Environment) -> + Args = hipe_icode:enter_args(Instruction), + EvalArgs = [lookup_lattice_value(X, Environment) || X <- Args], + Fun = hipe_icode:enter_fun(Instruction), + case lists:any(fun(X) -> (X =:= bottom) end, EvalArgs) of + true -> + update_enter_arguments(Instruction, Environment); + false -> + ConstVals = [hipe_icode:const_value(X) || X <- EvalArgs], + try evaluate_call_or_enter(ConstVals, Fun) of + bottom -> + update_enter_arguments(Instruction, Environment); + Const -> + Dst = hipe_icode:mk_new_var(), + [hipe_icode:mk_move(Dst, Const), + hipe_icode:mk_return([Dst])] + catch + _:_ -> + update_enter_arguments(Instruction, Environment) + end + end. + +update_enter_arguments(Instruction, Env) -> + NewArguments = update_arguments(hipe_icode:enter_args(Instruction), Env), + [hipe_icode:enter_args_update(Instruction, NewArguments)]. + +%%----------------------------------------------------------------------------- + +update_if(Instruction, Environment) -> + Args = hipe_icode:if_args(Instruction), + EvaluatedArguments = [lookup_lattice_value(Argument, Environment) + || Argument <- Args], + Op = hipe_icode:if_op(Instruction), + case evaluate_if(Op, EvaluatedArguments) of + true -> + TrueLabel = hipe_icode:if_true_label(Instruction), + ?CONST_PROP_MSG("ifT: ~w ---> goto ~w\n", [Instruction, TrueLabel]), + [hipe_icode:mk_goto(TrueLabel)]; + false -> + FalseLabel = hipe_icode:if_false_label(Instruction), + ?CONST_PROP_MSG("ifF: ~w ---> goto ~w\n", [Instruction, FalseLabel]), + [hipe_icode:mk_goto(FalseLabel)]; + bottom -> + %% Convert the if-test to a type test if possible. + Op = hipe_icode:if_op(Instruction), + case Op =:= '=:=' orelse Op =:= '=/=' of + false -> [Instruction]; + true -> + [Arg1, Arg2] = Args, + case EvaluatedArguments of + [bottom, bottom] -> + [Instruction]; + [bottom, X] -> + conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg1); + [X, bottom] -> + conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg2) + end + end + end. + +conv_if_to_type(I, Const, Arg) when is_atom(Const); + is_integer(Const); + Const =:= [] -> + Test = + if is_atom(Const) -> {atom, Const}; + is_integer(Const) -> {integer, Const}; + true -> nil + end, + {T, F} = + case hipe_icode:if_op(I) of + '=:=' -> {hipe_icode:if_true_label(I),hipe_icode:if_false_label(I)}; + '=/=' -> {hipe_icode:if_false_label(I),hipe_icode:if_true_label(I)} + end, + NewI = hipe_icode:mk_type([Arg], Test, T, F), + ?CONST_PROP_MSG("if: ~w ---> type ~w\n", [I, NewI]), + [NewI]; +conv_if_to_type(I, _, _) -> + [I]. + +%%----------------------------------------------------------------------------- + +update_move(Instruction, Environment) -> + Destination = hipe_icode:move_dst(Instruction), + case lookup_lattice_value(Destination, Environment) of + bottom -> + [Instruction]; + X -> + case hipe_icode:move_src(Instruction) of + X -> + [Instruction]; + _ -> + ?CONST_PROP_MSG("move: ~w ---> ~w\n", [Instruction, X]), + [hipe_icode:move_src_update(Instruction, X)] + end + %% == [hipe_icode:mk_move(Destination, X)] + end. + +%%----------------------------------------------------------------------------- + +update_phi(Instruction, Environment) -> + Destination = hipe_icode:phi_dst(Instruction), + case lookup_lattice_value(Destination, Environment) of + bottom -> + [Instruction]; + X -> + ?CONST_PROP_MSG("phi: ~w ---> ~w\n", [Instruction, X]), + [hipe_icode:mk_move(Destination, X)] + end. + +%%----------------------------------------------------------------------------- + +update_type(Instruction, Environment) -> + EvaluatedArguments = [lookup_lattice_value(Argument, Environment) || + Argument <- hipe_icode:type_args(Instruction)], + case evaluate_type(hipe_icode:type_test(Instruction), EvaluatedArguments) of + true -> + TrueLabel = hipe_icode:type_true_label(Instruction), + ?CONST_PROP_MSG("typeT: ~w ---> goto ~w\n", [Instruction, TrueLabel]), + [hipe_icode:mk_goto(TrueLabel)]; + false -> + FalseLabel = hipe_icode:type_false_label(Instruction), + ?CONST_PROP_MSG("typeF: ~w ---> goto ~w\n", [Instruction, FalseLabel]), + [hipe_icode:mk_goto(FalseLabel)]; + bottom -> + [Instruction] + end. + +%%----------------------------------------------------------------------------- + +update_switch_val(Instruction, Environment) -> + Argument = hipe_icode:switch_val_term(Instruction), + Value = lookup_lattice_value(Argument, Environment), + case Value of + bottom -> + [Instruction]; + _ -> + Cases = hipe_icode:switch_val_cases(Instruction), + FailLabel = hipe_icode:switch_val_fail_label(Instruction), + Target = get_switch_target(Cases, Value, FailLabel), + ?CONST_PROP_MSG("sv: ~w ---> goto ~w\n", [Instruction, Target]), + [hipe_icode:mk_goto(Target)] + end. + +%%----------------------------------------------------------------------------- + +update_switch_tuple_arity(Instruction, Environment) -> + Argument = hipe_icode:switch_tuple_arity_term(Instruction), + Value = lookup_lattice_value(Argument, Environment), + case Value of + bottom -> + [Instruction]; + Constant -> + UnTagged = hipe_icode:const_value(Constant), + case is_tuple(UnTagged) of + true -> + Cases = hipe_icode:switch_tuple_arity_cases(Instruction), + FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction), + Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel), + ?CONST_PROP_MSG("sta: ~w ---> goto ~w\n", [Instruction, Target]), + [hipe_icode:mk_goto(Target)]; + false -> + [Instruction] + %% TODO: Can the above be replaced with below??? Perhaps + %% together with some sort of "generate failure". + %% [hipe_icode:mk_goto(FailLabel)] + end + end. + +%%----------------------------------------------------------------------------- + +lookup_lattice_value(X, Environment) -> + LatticeValues = env__lattice_values(Environment), + case hipe_icode:is_const(X) of + true -> + X; + false -> + case gb_trees:lookup(X, LatticeValues) of + none -> + ?WARNING_MSG("Earlier compiler steps generated erroneous " + "code for X = ~w. We are ignoring this.\n",[X]), + bottom; + {value, top} -> + ?EXIT({"lookup_lattice_value, top", X}); + {value, Y} -> + Y + end + end. + +%%----------------------------------------------------------------------------- + +update_arguments(ArgumentList, Environment) -> + [case lookup_lattice_value(X, Environment) of + bottom -> + X; + Constant -> + Constant + end || X <- ArgumentList]. + +%%----------------------------- End of file ----------------------------------- diff --git a/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl new file mode 100644 index 0000000000..1899c09715 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl @@ -0,0 +1,41 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-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_icode_ssa_copy_prop.erl +%% Author : Tobias Lindahl +%% Description : Performs copy propagation on SSA form. +%% +%% Created : 4 Apr 2003 by Tobias Lindahl +%%------------------------------------------------------------------- + +-module(hipe_icode_ssa_copy_prop). + +%% +%% modules given as parameters +%% +-define(code, hipe_icode). +-define(cfg, hipe_icode_cfg). + +%% +%% appropriate include files +%% +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). +-include("../ssa/hipe_ssa_copy_prop.inc"). diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl new file mode 100644 index 0000000000..675c8c1ad8 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl @@ -0,0 +1,1444 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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_icode_ssa_struct_reuse.erl +%% Author : Ragnar Osterlund +%% student at the compiler techniques 2 course at UU 2007 +%% Description : HiPE module that removes redundant or partially redundant +%% structure creations from Icode. +%% It does so by inserting redundant expressions as late +%% as possible in the CFG, with the exception of loops where +%% expressions are moved to just before the loop head. +%% Current Icode instructions that can be moved are mktuple() +%% and cons() primop calls. It also handles cases like +%% f({Z}) -> {Z}. It does so by looking at the structure of +%% the match, and recognizes tuples and conses. +%%======================================================================= + +-module(hipe_icode_ssa_struct_reuse). + +-export([struct_reuse/1]). + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). +-include("../flow/cfg.hrl"). + +-define(SET, ordset). +-define(SETS, ordsets). +%%-define(DEBUG, true). + +-define(MKTUPLE, mktuple). +-define(CONS, cons). +-define(SR_INSTR_TYPE, sr_instr_type). +-define(SR_STRUCT_INSTR_TYPE, sr_struct_instr_type). + +-type struct_type() :: {?CONS | ?MKTUPLE, icode_term_arg(), any()}. +-type struct_elems() :: {icode_var(), non_neg_integer(), icode_term_arg()}. + +%% DATATYPE AREA + +%%----------------------------------------------------------------------------- +%% maps +%% The maps are used to identify variables and expressions. +%% The maps are: +%% +%% expr - a map that contains value numbered structure expressions, ie +%% mktuple and cons expression. The key is the value number and the value +%% is an expr record. +%% +%% instr - maps the semantic instruction to an expression value number, +%% that is, a key in the expr map above. +%% +%% var - maps variables to expression value numbers. These variables are +%% defined or used by the structure expressions. + +-record(maps, {var = gb_trees:empty() :: gb_tree(), + instr = gb_trees:empty() :: gb_tree(), + expr = gb_trees:empty() :: gb_tree()}). + +maps_var(#maps{var = Out}) -> Out. +maps_instr(#maps{instr = Out}) -> Out. +maps_expr(#maps{expr = Out}) -> Out. + +maps_expr_keys(Maps) -> gb_trees:keys(maps_expr(Maps)). +maps_expr_values(Maps) -> gb_trees:values(maps_expr(Maps)). + +maps_instr_lookup(Instr, Maps) -> gb_trees:lookup(Instr, maps_instr(Maps)). +maps_instr_enter(Instr, ExprId, Maps) -> + NewInstr = gb_trees:enter(Instr, ExprId, maps_instr(Maps)), + Maps#maps{instr = NewInstr}. + +maps_expr_get(Id, Maps) -> gb_trees:get(Id, maps_expr(Maps)). +maps_expr_enter(Expr, Maps) -> + NewExprMap = gb_trees:enter(expr_id(Expr), Expr, maps_expr(Maps)), + Maps#maps{expr = NewExprMap}. + +maps_var_get(Var, Maps) -> gb_trees:get(Var, maps_var(Maps)). +maps_var_lookup(Var, #maps{var = VarMap}) -> gb_trees:lookup(Var, VarMap). +maps_var_enter(Var, Info, Maps = #maps{var = VarMap}) -> + NewMap = gb_trees:enter(Var, Info, VarMap), + Maps#maps{var = NewMap}. +maps_var_insert(Var, Info, Maps = #maps{var = VarMap}) -> + NewMap = gb_trees:insert(Var, Info, VarMap), + Maps#maps{var = NewMap}. + +maps_balance(Maps) -> + Maps#maps{instr = gb_trees:balance(maps_instr(Maps)), + expr = gb_trees:balance(maps_expr(Maps)), + var = gb_trees:balance(maps_var(Maps))}. + +maps_expr_key_enter(Expr, Maps) -> + NewMaps = maps_instr_enter(expr_key(Expr), expr_id(Expr), Maps), + maps_expr_enter(Expr, NewMaps). + +%%----------------------------------------------------------------------------- +%% expr +%% An expression record. Contains information about a structure expression. +%% The fields are: +%% +%% id - the value number of the expression +%% key - the semantic instruction, as defined in icode, with destination +%% removed and arguments rewritten. +%% defs - destination variable to hold the value of the expression. +%% direct_replace - indicates whether the expression shall be replaced wherever +%% it occurs, although it might not have been inserted. This is used for +%% the expressions that are detected by the icode type constructs. +%% inserts - a list of node labels that will insert this expression +%% use - a list of expression value numbers that use the value of this +%% expression + +-record(expr, {id = none :: 'none' | non_neg_integer(), + key = none :: 'none' | tuple(), % illegal_icode_instr() + defs = none :: 'none' | [icode_var()], + direct_replace = false :: boolean(), + inserts = ?SETS:new() :: ?SET(_), + use = ?SETS:new() :: ?SET(_)}). + +expr_id(#expr{id = Out}) -> Out. +expr_defs(#expr{defs = Out}) -> Out. +expr_key(#expr{key = Out}) -> Out. +expr_inserts(#expr{inserts = Out}) -> Out. +expr_use(#expr{use = Out}) -> Out. +expr_direct_replace(#expr{direct_replace = Out}) -> Out. + +expr_use_add(Expr = #expr{use = UseSet}, Use) -> + Expr#expr{use = ?SETS:add_element(Use, UseSet)}. + +%% expr_key_set(Expr, In) -> Expr#expr{key = In}. +expr_direct_replace_set(Expr, In) -> Expr#expr{direct_replace = In}. +expr_inserts_set(Expr, In) -> Expr#expr{inserts = In}. + +expr_create(Key, Defs) -> + NewExprId = new_expr_id(), + #expr{id = NewExprId, key = Key, defs = Defs}. + +%%----------------------------------------------------------------------------- +%% varinfo +%% A variable mapping info. Contains info about variable references. +%% The fields are: +%% +%% use - a set of expression value numbers that use this variable +%% ref - the variable which value this variable will be assigned +%% when expression is replaced. This is encoded as {N, M} where +%% N is the expression value number and M is the nth destination +%% variable defined by the expression N. +%% elem - indicates that this variable has been detected to be a part of +%% a tuple. The field contains a {V, N} tuple where V is the variable +%% that refers to the structure that this variable is an element in +%% and N is the position that the element occurs on in the tuple. Eg. +%% {{var, 3}, 2} means that the variable {var, 3} refers to a tuple +%% in which this variable is on second place. +%% exprid - a expression value number which is the expression that +%% the variable is defined by. + +-record(varinfo, {use = ?SETS:new() :: ?SET(_), + ref = none :: 'none' | {non_neg_integer(), non_neg_integer()}, + elem = none :: 'none' | {icode_var(), non_neg_integer()}, + exprid = none :: 'none' | non_neg_integer()}). + +varinfo_exprid(#varinfo{exprid = Out}) -> Out. + +varinfo_use_add(#varinfo{use = UseSet} = I, Use) -> + I#varinfo{use = ?SETS:add_element(Use, UseSet)}. + +%%----------------------------------------------------------------------------- +%% node - a node in the temp CFG. +%% +%% label - the label of the node in the original CFG +%% pred - a list of predecessors to this node +%% succ - a list of successors to this node +%% code - code from CFG filtered to only contain structure instructions +%% non_struct_defs - a list of variable definitions that are not defined +%% by structures +%% up_expr - upwards exposed expression value numbers +%% killed_expr - killed expressions value numbers +%% sub_inserts - a set of labels of nodes that defines one or more +%% expressions and that are in a subtree of this node +%% inserts - a set of expression value numbers to be inserted into the node +%% antic_in - a set of expression value numbers that are anticipated into +%% the node +%% antic_out - a set of expression value numbers that are anticipated out of +%% the node +%% phi - a tree of node labels which is defined in phi functions in the node +%% varmap - a list of variable tuples {V1, V2} that maps a variable that are +%% the output of phi functions in sub blocks, V1, into a variable +%% flowing from the block of this node, V2. +%% struct_type - a list of {V, N} tuples that indicates that V is a tuple +%% with N elements. These are added from the icode primop type(). +%% struct_elems - a list of {VD, N, VS} tuples where VD is a variable in the N'th position +%% in VS. These are added from the icode primop unsafe_element() + +-record(node, { + label = none :: 'none' | icode_lbl(), + pred = none :: 'none' | [icode_lbl()], + succ = none :: 'none' | [icode_lbl()], + code = [] :: [tuple()], % [illegal_icode_instr()] + phi = gb_trees:empty() :: gb_tree(), + varmap = [] :: [{icode_var(), icode_var()}], + pre_loop = false :: boolean(), + non_struct_defs = gb_sets:new() :: gb_set(), + up_expr = none :: 'none' | ?SET(_), + killed_expr = none :: 'none' | ?SET(_), + sub_inserts = ?SETS:new() :: ?SET(_), + inserts = ?SETS:new() :: ?SET(_), + antic_in = none :: 'none' | ?SET(_), + antic_out = none :: 'none' | ?SET(_), + struct_type = [] :: [struct_type()], + struct_elems = [] :: [struct_elems()]}). + +node_sub_inserts(#node{sub_inserts = Out}) -> Out. +node_inserts(#node{inserts = Out}) -> Out. +node_antic_out(#node{antic_out = Out}) -> Out. +node_antic_in(#node{antic_in = Out}) -> Out. +node_killed_expr(#node{killed_expr = Out}) -> Out. +node_pred(#node{pred = Out}) -> Out. +node_succ(#node{succ = Out}) -> Out. +node_label(#node{label = Out}) -> Out. +node_code(#node{code = Out}) -> Out. +node_non_struct_defs(#node{non_struct_defs = Out}) -> Out. +node_up_expr(#node{up_expr = Out}) -> Out. +node_pre_loop(#node{pre_loop = Out}) -> Out. +node_struct_type(#node{struct_type = Out}) -> Out. +%% node_atom_type(#node{atom_type = Out}) -> Out. +node_struct_elems(#node{struct_elems = Out}) -> Out. + +node_pre_loop_set(Node) -> Node#node{pre_loop = true}. + +node_phi_add(Node = #node{phi = Phi}, Pred, Value) -> + NewList = + case gb_trees:lookup(Pred, Phi) of + {value, List} -> [Value | List]; + none -> [Value] + end, + Node#node{phi = gb_trees:enter(Pred, NewList, Phi)}. + +node_phi_get(#node{phi = Phi}, Pred) -> + case gb_trees:lookup(Pred, Phi) of + {value, List} -> List; + none -> [] + end. + +node_code_add(Node = #node{code = Code}, Instr) -> + Node#node{code = [Instr | Code]}. + +node_code_rev(Node = #node{code = Code}) -> + Node#node{code = lists:reverse(Code)}. + +node_struct_type_add(Node = #node{struct_type = T}, Value) -> + Node#node{struct_type = [Value | T]}. + +%% node_atom_type_add(Node = #node{atom_type = T}, Value) -> +%% Node#node{atom_type = [Value | T]}. + +node_struct_elems_add(Node = #node{struct_elems = T}, Value) -> + Node#node{struct_elems = [Value | T]}. + +node_non_struct_defs_list(Node) -> + gb_sets:to_list(node_non_struct_defs(Node)). + +node_non_struct_instr_add(Node, Instr) -> + DefList = hipe_icode:defines(Instr), + Tmp = gb_sets:union(node_non_struct_defs(Node), gb_sets:from_list(DefList)), + Node#node{non_struct_defs = Tmp}. + +node_set_sub_inserts(Node, In) -> Node#node{sub_inserts = In}. + +node_add_insert(Node, In) -> + NewIns = ?SETS:add_element(In, node_inserts(Node)), + Node#node{inserts = NewIns}. + +node_union_sub_inserts(Node, SubIns) -> + NewSubIns = ?SETS:union(SubIns, node_sub_inserts(Node)), + node_set_sub_inserts(Node, NewSubIns). + +node_varmap_set(Node, Vars) -> + Node#node{varmap = Vars}. + +node_varmap_lookup(#node{varmap = Varmap}, Var) -> + case lists:keyfind(Var, 1, Varmap) of + {_, NewVar} -> NewVar; + false -> Var + end. + +node_create(Label, Pred, Succ) -> + #node{label = Label, pred = Pred, succ = Succ}. + +%%----------------------------------------------------------------------------- +%% nodes - describes the new temporary CFG +%% +%% domtree - the dominator tree of the original CFG +%% labels - the labels of the original CFG, filtered to only contain non fail trace paths +%% postorder - the postorder walk of labels of the original CFG, filtered to only contain non fail trace paths +%% rev_postorder - reverse of postorder. +%% start_label - the start basic block label. +%% all_expr - all expression value numbers that the CFG defines +%% tree - the tree of nodes, with labels as keys and node records as values + +-record(nodes, { + domtree :: hipe_dominators:domTree(), + labels = none :: 'none' | [icode_lbl()], + postorder = none :: 'none' | [icode_lbl()], + start_label = none :: 'none' | icode_lbl(), + rev_postorder = none :: 'none' | [icode_lbl()], + all_expr = none :: 'none' | [non_neg_integer()], + tree = gb_trees:empty() :: gb_tree()}). + +nodes_postorder(#nodes{postorder = Out}) -> Out. +nodes_rev_postorder(#nodes{rev_postorder = Out}) -> Out. +nodes_tree(#nodes{tree = Out}) -> Out. +nodes_domtree(#nodes{domtree = Out}) -> Out. +nodes_start_label(#nodes{start_label = Out}) -> Out. + +nodes_tree_is_empty(#nodes{tree = Tree}) -> + gb_trees:is_empty(Tree). + +nodes_tree_set(Tree, Nodes) -> Nodes#nodes{tree = Tree}. +nodes_all_expr_set(AllExpr, Nodes) -> Nodes#nodes{all_expr = AllExpr}. + +nodes_tree_values(Nodes) -> + gb_trees:values(nodes_tree(Nodes)). + +get_node(Label, Nodes) -> + gb_trees:get(Label, nodes_tree(Nodes)). + +enter_node(Node, Nodes) -> + nodes_tree_set(gb_trees:enter(node_label(Node), Node, nodes_tree(Nodes)), Nodes). + +remove_node(Node, Nodes) -> + nodes_tree_set(gb_trees:delete(node_label(Node), nodes_tree(Nodes)), Nodes). + +nodes_create() -> #nodes{}. + +%%----------------------------------------------------------------------------- +%% update +%% record used when updating the CFG, keeping track of which expressions +%% have been inserted and their mappings to variable names. +%% +%% inserted - maps an expression to a list of variables +%% del_red_test - flag that is set to true when the reduction test +%% has been inserted is used to move the reduction test. + +-record(update, {inserted = gb_trees:empty() :: gb_tree(), + del_red_test = false :: boolean()}). + +update_inserted_lookup(#update{inserted = Inserted}, ExprId) -> + gb_trees:lookup(ExprId, Inserted). + +update_inserted_add_new(Update = #update{inserted = Inserted}, ExprId, Defs) -> + VarList = [case hipe_icode:is_var(Def) of + true -> hipe_icode:mk_new_var(); + false -> + case hipe_icode:is_reg(Def) of + true -> hipe_icode:mk_new_reg(); + false -> + true = hipe_icode:is_fvar(Def), + hipe_icode:mk_new_fvar() + end + end || Def <- Defs], + NewInserted = gb_trees:enter(ExprId, VarList, Inserted), + {Update#update{inserted = NewInserted}, VarList}. + +update_inserted_add(Update = #update{inserted = Inserted}, ExprId, Defs) -> + Update#update{inserted = gb_trees:enter(ExprId, Defs, Inserted)}. + +update_del_red_test(#update{del_red_test = DelRed}) -> DelRed. +update_del_red_test_set(Update) -> + Update#update{del_red_test = true}. + +%%----------------------------------------------------------------------------- +%% CODE AREA + +%%----------------------------------------------------------------------------- +%% Main function called from the hipe_main module + +-spec struct_reuse(#cfg{}) -> #cfg{}. + +struct_reuse(CFG) -> + %% debug_init_case_count(?SR_INSTR_TYPE), + %% debug_init_case_count(?SR_STRUCT_INSTR_TYPE), + + %% debug_function({wings_ask,ask_unzip,3}, CFG), + %% debug_function(nil, CFG), + %% set_debug_flag(true), + %% debug_struct("CFG In: ", CFG), + %% debug_cfg_pp(CFG), + + init_expr_id(), + + Nodes = construct_nodes(CFG), + + case nodes_tree_is_empty(Nodes) of + false -> + Maps = create_maps(Nodes), + + Nodes3 = init_nodes(Nodes, Maps), + Nodes4 = calc_anticipated(Nodes3), + + {Nodes5, Maps3} = calc_inserts(Nodes4, Maps), + + Nodes6 = update_nodes_inserts(Nodes5, Maps3), + + %% debug_list("ExprMap: ", gb_trees:to_list(Maps3#maps.expr)), + %% debug_list("VarMap: ", gb_trees:to_list(maps_var(Maps3))), + %% debug_nodes(Nodes6), + + %% update the cfg + CFG1 = rewrite_cfg(CFG, Nodes6, Maps3), + CFG2 = hipe_icode_ssa:remove_dead_code(CFG1), + CFGOut = hipe_icode_ssa_copy_prop:cfg(CFG2), + %% CFGOut = CFG1, + + %% print_struct("CFG: ", CFG), + %% debug_cfg_pp(CFG), + %% debug_cfg_pp(CFGOut), + + %% debug_print_case_count(?SR_STRUCT_INSTR_TYPE), + %% debug_print_case_count(?SR_INSTR_TYPE), + %% debug("Done~n"), + %% debug_struct("CFG Out: ", CFGOut), + CFGOut; + true -> + CFG + end. + +%%----------------------------------------------------------------------------- +%% Calculate simplified CFG with all fail paths removed + +construct_nodes(CFG) -> + %% all important dominator tree + DomTree = hipe_dominators:domTree_create(CFG), + + %% construct initial nodes + {Nodes, NonFailSet} = nodes_from_cfg(CFG, DomTree), + + %% remove nodes on fail paths + NewNodes = prune_nodes(Nodes, NonFailSet), + + %% fill in misc node tree info + Postorder = [Label || Label <- hipe_icode_cfg:postorder(CFG), + gb_sets:is_member(Label, NonFailSet)], + + %% check postorder is valid + PostOrderTmp = hipe_icode_cfg:postorder(CFG), + LabelsTmp = hipe_icode_cfg:labels(CFG), + case length(PostOrderTmp) =/= length(LabelsTmp) of + true -> + print("Warning, Postorder and Labels differ!~n"), + print_struct("Postorder: ", PostOrderTmp), + print_struct("Labels: ", LabelsTmp); + false -> + done + end, + + RevPostorder = lists:reverse(Postorder), + + StartLabel = hipe_icode_cfg:start_label(CFG), + NewTree = gb_trees:balance(nodes_tree(NewNodes)), + + NewNodes#nodes{postorder = Postorder, + rev_postorder = RevPostorder, + start_label = StartLabel, + tree = NewTree, + domtree = DomTree}. + +%%----------------------------------------------------------------------------- +%% Constructs a tree of nodes, one node for each basic block in CFG + +nodes_from_cfg(CFG, DomTree) -> + lists:foldl(fun(Label, {NodesAcc, NonFailAcc}) -> + Code = hipe_bb:code(hipe_icode_cfg:bb(CFG, Label)), + Pred = hipe_icode_cfg:pred(CFG, Label), + Succ = hipe_icode_cfg:succ(CFG, Label), + %% debug_struct("Label: ", Label), + %% debug_struct("Code: ", Code), + + %% Find all structures and phi functions. + %% Find all defines in this bb that are not from structures + %% and add them to NonStructDefs, later to be used for calculating upwards + %% exposed expressions, and killed expressions. + %% Also find all non fail blocks, ie backtrace from return blocks, + %% and add them to NewNonFailAcc + + Node = node_create(Label, Pred, Succ), + + {NewNode, NewNonFailAcc, PreLoopPreds} = + lists:foldl(fun(Instr, {NodeAcc, NFAcc, PLPAcc}) -> + case instr_type(Instr) of + struct -> + {node_code_add(NodeAcc, Instr), NFAcc, PLPAcc}; + return -> + {NodeAcc, get_back_trace_rec(CFG, Label, NFAcc), PLPAcc}; + {struct_elems, NumElem, DstVar, SrcVar} -> + NewNodeAcc = node_struct_elems_add(NodeAcc, {DstVar, NumElem, SrcVar}), + {node_non_struct_instr_add(NewNodeAcc, Instr), NFAcc, PLPAcc}; + {struct_type, NumElems, Var, Type} -> + {node_struct_type_add(NodeAcc, {Type, Var, NumElems}), NFAcc, PLPAcc}; + {tuple_arity, Var, Cases} -> + NewNodeAcc = + lists:foldl(fun(Case, NAcc) -> + case Case of + {{const, {flat, Arity}}, _} -> + Tuple = {?MKTUPLE, Var, Arity}, + node_struct_type_add(NAcc, Tuple); + _ -> NAcc + end + end, NodeAcc, Cases), + {NewNodeAcc, NFAcc, PLPAcc}; + %% {atom_type, Atom, Var} -> + %% {node_atom_type_add(NodeAcc, {Var, Atom}), NFAcc, PLPAcc}; + phi -> + Def = hipe_icode:phi_dst(Instr), + Part = lists:foldl(fun(P = {Pr, PredVar}, {IsDef, NotDom}) -> + case hipe_dominators:domTree_dominates(Label, Pr, DomTree) of + false -> + {IsDef, [P | NotDom]}; + true -> + {IsDef andalso PredVar =:= Def, NotDom} + end + end, {true, []}, hipe_icode:phi_arglist(Instr)), + + case Part of + {true, [{P, V}]} -> + %% This is the only case recognized so far. All phi + %% sub block references a static variable that is + %% assigned the same value again in the phi function. + {node_phi_add(NodeAcc, P, {Def, V}), + NFAcc, ?SETS:add_element(P, PLPAcc)}; + + {false, [{P, _}]} -> + {node_non_struct_instr_add(NodeAcc, Instr), + NFAcc, ?SETS:add_element(P, PLPAcc)}; + + _ -> + {node_non_struct_instr_add(NodeAcc, Instr), NFAcc, PLPAcc} + end; + _ -> + {node_non_struct_instr_add(NodeAcc, Instr), NFAcc, PLPAcc} + end + end, {Node, NonFailAcc, ?SETS:new()}, Code), + + %% insert the new node + NewNodesAcc = enter_node(node_code_rev(NewNode), NodesAcc), + + %% Set the pre loop flag of all nodes that are predecessor to this node + %% and that are the first nodes prior to a loop. + NewNodesAcc2 = + lists:foldl(fun(Lbl, NsAcc) -> + PredNode = get_node(Lbl, NsAcc), + NewPredNode = node_pre_loop_set(PredNode), + NewPredNode2 = node_varmap_set(NewPredNode, node_phi_get(NewNode, Lbl)), + + enter_node(NewPredNode2, NsAcc) + end, NewNodesAcc, PreLoopPreds), + + {NewNodesAcc2, NewNonFailAcc} + end, {nodes_create(), gb_sets:new()}, hipe_icode_cfg:reverse_postorder(CFG)). + +%%----------------------------------------------------------------------------- +%% Get all labels from Label to root of CFG, ie backtraces from Label. + +get_back_trace_rec(CFG, Label, LabelSet) -> + %% debug_struct("Label :", Label), + %% debug_struct("Set :", gb_sets:to_list(LabelSet)), + case gb_sets:is_member(Label, LabelSet) of + false -> + Preds = hipe_icode_cfg:pred(CFG, Label), + lists:foldl(fun(Lbl, SetAcc) -> + get_back_trace_rec(CFG, Lbl, SetAcc) + end, gb_sets:add(Label, LabelSet), Preds); + true -> LabelSet + end. + +%%----------------------------------------------------------------------------- +%% Remove all fail block paths and successors and predecessors +%% That are on fail paths + +prune_nodes(Nodes, NonFailSet) -> + lists:foldl(fun(Node, NodesAcc) -> + case gb_sets:is_member(node_label(Node), NonFailSet) of + true -> + NewSucc = [L || L <- node_succ(Node), gb_sets:is_member(L, NonFailSet)], + NewPred = [L || L <- node_pred(Node), gb_sets:is_member(L, NonFailSet)], + enter_node(Node#node{succ = NewSucc, pred = NewPred}, NodesAcc); + false -> + remove_node(Node, NodesAcc) + end + end, Nodes, nodes_tree_values(Nodes)). + +%%----------------------------------------------------------------------------- +%% Map calculations. + +%%----------------------------------------------------------------------------- +%% Create a maps structure from the Nodes record + +create_maps(Nodes) -> + Maps = lists:foldl(fun(Label, MapsAcc) -> + Node = get_node(Label, Nodes), + NewMapsAcc = maps_from_node_struct_type(MapsAcc, Node), + NewMapsAcc2 = maps_from_node_struct_elems(NewMapsAcc, Node), + %% NewMapsAcc3 = maps_from_node_atom_type(NewMapsAcc2, Node), + maps_from_node_code(NewMapsAcc2, Node) + end, #maps{}, nodes_rev_postorder(Nodes)), + maps_balance(Maps). + +%%----------------------------------------------------------------------------- +%% Add all elements in the struct_type list of Node to Maps as expressions + +maps_from_node_struct_type(Maps, Node) -> + %% debug_struct("Node Label: ", node_label(Node)), + %% debug_struct("Node Tuple Type: ", node_struct_type(Node)), + lists:foldl(fun({Type, Var, Size}, MapsAcc) -> + Key = create_elem_expr_key(Size, Var, []), + InstrKey = hipe_icode:mk_primop([], Type, Key), + NewExpr2 = expr_create(InstrKey, [Var]), + NewExpr3 = expr_direct_replace_set(NewExpr2, true), + maps_expr_key_enter(NewExpr3, MapsAcc) + end, Maps, node_struct_type(Node)). + +create_elem_expr_key(0, _, Key) -> Key; +create_elem_expr_key(N, Var, Key) -> + create_elem_expr_key(N - 1, Var, [{Var, N} | Key]). + +%%----------------------------------------------------------------------------- +%%maps_from_node_atom_type(Maps, Node) -> +%% lists:foldl(fun({Var, Atom}, MapsAcc) -> +%% case maps_var_lookup(Var, MapsAcc) of +%% none -> +%% MapsAcc; +%% {value, #varinfo{elem = none}} -> +%% MapsAcc; +%% {value, #varinfo{elem = {Src, Num, ExprId}}} -> +%% Expr = maps_expr_get(ExprId, MapsAcc), +%% Key = expr_key(Expr), +%% +%% Filter = fun(Arg) -> +%% case Arg of +%% {Src, Num, ExprId} -> +%% hipe_icode:mk_const(Atom); +%% _ -> +%% Arg +%% end end, +%% +%% NewKey = replace_call_variables(Filter, Key), +%% NewExpr = expr_create(NewKey, expr_defs(Expr)), +%% maps_expr_key_enter(NewExpr, MapsAcc) +%% end +%% end, Maps, node_atom_type(Node)). + +%%----------------------------------------------------------------------------- +%% Add all struct_elemns in Node to Maps as variables + +maps_from_node_struct_elems(Maps, Node) -> + lists:foldl(fun({Dst, Num, Src}, MapsAcc) -> + VarInfo = #varinfo{elem = {Src, Num}}, + maps_var_insert(Dst, VarInfo, MapsAcc) + end, Maps, node_struct_elems(Node)). + +%%----------------------------------------------------------------------------- +%% Get all expressions defined by the Node and insert them into Maps. +%% Also insert information about all affected variables into Maps. + +maps_from_node_code(Maps, Node) -> + %% debug_struct("Node Label: ", Label), + %% debug_struct("Node Code: ", Code), + %% Label = node_label(Node), + lists:foldl(fun(Instr, MapsAcc) -> + %% create two keys that are used to reference this structure creation + %% instruction, so that we can lookup its expression value number + %% later. + InstrKey = hipe_icode:call_dstlist_update(Instr, []), + + %% Fetch the two keys from the instruction + {HasElems, RefKey, ElemKey} = + replace_call_vars_elems(MapsAcc, InstrKey), + + %% create a new expr record or lookup an existing one. + case HasElems of + true -> + %% The instruction contains uses of variables that are + %% part of another structure. + case maps_instr_lookup(ElemKey, MapsAcc) of + {value, ExprId} -> + %% The instruction is equal to a structure that has + %% already been created. This is the f({Z}) -> {Z} + %% optimization. I.e. there is no need to create {Z} again. + %% Also lookup if ExprId is defining a variable that is + %% already an element in another structure. If so, + %% use that element. This takes care of nested structures + %% such as f({X, {Y, Z}}) -> {X, {Y, Z}}. + + #expr{defs = [Var]} = maps_expr_get(ExprId, MapsAcc), + StructElem = + case maps_var_lookup(Var, MapsAcc) of + {value, #varinfo{elem = Elem, exprid = none}} when Elem =/= none -> + Elem; + _ -> none + end, + Defines = hipe_icode:defines(Instr), + maps_varinfos_create(Defines, ExprId, StructElem, MapsAcc); + none -> + %% create a new expression + maps_expr_varinfos_create(Instr, RefKey, MapsAcc) + end; + false -> + %% create a new expression + maps_expr_varinfos_create(Instr, RefKey, MapsAcc) + end + end, Maps, node_code(Node)). + +%%----------------------------------------------------------------------------- +%% Creates varinfo structures with exprid set to ExprId for all +%% variables contained in Defines. These are put into MapsIn. + +maps_varinfos_create(Defines, ExprId, Elem, MapsIn) -> + VarInfo = #varinfo{exprid = ExprId, elem = Elem}, + {MapsOut, _} = + lists:foldl(fun (Def, {Maps, NumAcc}) -> + NewVarInfo = VarInfo#varinfo{ref = {ExprId, NumAcc}}, + {maps_var_insert(Def, NewVarInfo, Maps), NumAcc + 1} + end, {MapsIn, 1}, Defines), + MapsOut. + +%%----------------------------------------------------------------------------- +%% Creates a new expression from RefKey if RefKey is not already reffering +%% to an expression. Also creates varinfo structures for all variables defined +%% and used by Instr. Result is put in Maps. + +maps_expr_varinfos_create(Instr, RefKey, Maps) -> + Defines = hipe_icode:defines(Instr), + {ExprId, Maps2} = + case maps_instr_lookup(RefKey, Maps) of + {value, EId} -> + {EId, Maps}; + none -> + NewExpr = expr_create(RefKey, Defines), + {expr_id(NewExpr), maps_expr_key_enter(NewExpr, Maps)} + end, + Maps3 = maps_varinfos_create(Defines, ExprId, none, Maps2), + update_maps_var_use(Instr, ExprId, Maps3). + +%%----------------------------------------------------------------------------- +%% A variable replacement function that returns a tuple of three elements +%% {T, K1, K2}, where T indicates if Instr contained variables that where +%% elements of other structures, K1 is the Instr with all variables that +%% references another structure replaced, and K2 is K1 but also with all +%% variables that are elements of other structures replaced. + +replace_call_vars_elems(Maps, Instr) -> + VarMap = maps_var(Maps), + {HasElems, Vars, Elems} = + lists:foldr(fun(Arg, {HasElems, Vars, Elems}) -> + case hipe_icode:is_const(Arg) of + false -> + case gb_trees:lookup(Arg, VarMap) of + none -> + {HasElems, [Arg | Vars], [Arg | Elems]}; + {value, #varinfo{ref = none, elem = none}} -> + {HasElems, [Arg | Vars], [Arg | Elems]}; + {value, #varinfo{ref = Ref, elem = none}} -> + {HasElems, [Ref | Vars], [Ref | Elems]}; + {value, #varinfo{ref = none, elem = Elem}} -> + {true, [Arg | Vars], [Elem | Elems]}; + {value, #varinfo{ref = Ref, elem = Elem}} -> + {true, [Ref | Vars], [Elem | Elems]} + end; + true -> + {HasElems, [Arg | Vars], [Arg | Elems]} + end end, {false, [], []}, hipe_icode:args(Instr)), + {HasElems, hipe_icode:call_args_update(Instr, Vars), + hipe_icode:call_args_update(Instr, Elems)}. + +%%----------------------------------------------------------------------------- +%% Updates the usage information of all variables used by Instr to also +%% contain Id and updates Maps to contain the new variable information. +%% Also updates the expressions where the updated variables are used to +%% contain the use information. + +update_maps_var_use(Instr, Id, Maps) -> + lists:foldl(fun(Use, MapsAcc) -> + VarInfo = get_varinfo(Use, MapsAcc), + NewVarInfo = varinfo_use_add(VarInfo, Id), + MapsAcc2 = maps_var_enter(Use, NewVarInfo, MapsAcc), + case varinfo_exprid(VarInfo) of + none -> + MapsAcc2; + VarExprId -> + Expr = maps_expr_get(VarExprId, MapsAcc2), + NewExpr = expr_use_add(Expr, Id), + maps_expr_enter(NewExpr, MapsAcc2) + end + end, Maps, hipe_icode:uses(Instr)). + +%%----------------------------------------------------------------------------- +%% Looks up an old variable info or creates a new one if none is found. + +get_varinfo(Var, Maps) -> + case maps_var_lookup(Var, Maps) of + {value, Info} -> + Info; + none -> + #varinfo{} + end. + +%%----------------------------------------------------------------------------- +%% filters all arguments to a function call Instr that are not constants +%% through the Filter function, and replaces the arguments in Instr with +%% the result. + +replace_call_variables(Filter, Instr) -> + NewArgs = [case hipe_icode:is_const(Arg) of + false -> Filter(Arg); + true -> Arg + end || Arg <- hipe_icode:args(Instr)], + hipe_icode:call_args_update(Instr, NewArgs). + +%%----------------------------------------------------------------------------- +%% Init nodes from node local expression information + +init_nodes(Nodes, Maps) -> + AllExpr = maps_expr_keys(Maps), + lists:foldl(fun(Node, NodesAcc) -> + UEExpr = calc_up_exposed_expr(maps_var(Maps), Node), + %% print_list("Up ExprSet: ", ?SETS:to_list(UEExpr)), + + KilledExpr = calc_killed_expr(Node, Maps), + %% print_list("Killed: ", ?SETS:to_list(KilledExpr)), + + %% End nodes have no anticipated out + AnticOut = + case node_succ(Node) of + [] -> + ?SETS:new(); + _ -> + AllExpr + end, + enter_node(Node#node{up_expr = UEExpr, + killed_expr = KilledExpr, + antic_out = AnticOut}, NodesAcc) + end, nodes_all_expr_set(AllExpr, Nodes), nodes_tree_values(Nodes)). + +%%----------------------------------------------------------------------------- +%% Calculate the upwards exposed expressions for a node. + +calc_up_exposed_expr(VarMap, Node) -> + %% debug_struct("UpExpr label: ", node_label(Node)), + NonStructDefs = node_non_struct_defs(Node), + {_, ExprIdSet} = + lists:foldl(fun(Instr, {NotToUseAcc, ExprIdAcc}) -> + Defs = hipe_icode:defines(Instr), + Uses = hipe_icode:uses(Instr), + IsNotToUse = + lists:any(fun(Use) -> gb_sets:is_member(Use, NotToUseAcc) end, Uses), + case IsNotToUse of + false -> + NewExprIdAcc = + lists:foldl(fun(Def, Acc) -> + #varinfo{exprid = Id} = gb_trees:get(Def, VarMap), + ?SETS:add_element(Id, Acc) end, ExprIdAcc, Defs), + {NotToUseAcc, NewExprIdAcc}; + true -> + NewNotToUse = + gb_sets:union(gb_sets:from_list(Defs), NotToUseAcc), + {NewNotToUse, ExprIdAcc} + end + end, {NonStructDefs, ?SETS:new()}, node_code(Node)), + ExprIdSet. + +%%----------------------------------------------------------------------------- +%% Calculate killed expression for node + +calc_killed_expr(Node, Maps) -> + calc_killed_expr_defs(node_non_struct_defs_list(Node), ?SETS:new(), Maps). + +calc_killed_expr_defs(Defs, UseSet, Maps) -> + lists:foldl(fun(Def, Acc) -> + case maps_var_lookup(Def, Maps) of + none -> + Acc; + {value, #varinfo{use = Use}} -> + ?SETS:union(Acc, calc_killed_expr_use(Use, Maps)) + end + end, UseSet, Defs). + +calc_killed_expr_use(ExprIds, Maps) -> + ?SETS:fold(fun(Id, Acc) -> + Expr = maps_expr_get(Id, Maps), + ?SETS:union(Acc, calc_killed_expr_use(expr_use(Expr), Maps)) + end, ExprIds, ExprIds). + +%%----------------------------------------------------------------------------- +%% Calculate the anticipated in and anticipated out sets for each node + +calc_anticipated(NodesIn) -> + calc_anticipated_rec(NodesIn, nodes_postorder(NodesIn)). + +calc_anticipated_rec(NodesIn, []) -> NodesIn; +calc_anticipated_rec(NodesIn, WorkIn) -> + {NodesOut, WorkOut} = + lists:foldl(fun(Label, {NodesAcc, WorkAcc}) -> + Node = get_node(Label, NodesAcc), + + %debug_struct("~nNode Label: ", Label), + + AnticIn = ?SETS:union(node_up_expr(Node), + ?SETS:subtract(node_antic_out(Node), node_killed_expr(Node))), + + %debug_struct("AnticIn: ", AnticIn), + case (node_antic_in(Node) =:= AnticIn) of + false -> + NewNodes1 = enter_node(Node#node{antic_in = AnticIn}, NodesAcc), + Preds = node_pred(Node), + %debug_struct("Preds: ", Preds), + + NewNodes2 = + lists:foldl(fun(Label2, NodesAcc2) -> + PredNode = get_node(Label2, NodesAcc2), + AnticOut = ?SETS:intersection(AnticIn, node_antic_out(PredNode)), + %debug_struct("Pred Node Label: ", Label2), + %debug_struct("Pred AnticOut: ", AnticOut), + + enter_node(PredNode#node{antic_out = AnticOut}, NodesAcc2) + end, NewNodes1, Preds), + + NewWork = add_work_list(Preds, WorkAcc), + %debug_struct("New Work: ", NewWork), + + {NewNodes2, NewWork}; + true -> + {NodesAcc, WorkAcc} + end + end, {NodesIn, new_work()}, WorkIn), + + calc_anticipated_rec(NodesOut, get_work_list(WorkOut)). + +%%----------------------------------------------------------------------------- +%% Function that adds inserts to expressions from nodes which either +%% have an upwards exposed expression or dominate more than one node +%% that inserts the same expression or the node is a prior to loop +%% node. The inserted info is stored in the #expr records in the expr +%% map of the #maps structure. + +calc_inserts(NodesIn, MapsIn) -> + DomTree = nodes_domtree(NodesIn), + + lists:foldl(fun(Label, {NodesAcc, MapsAcc}) -> + Node = get_node(Label, NodesAcc), + + %% get some basic properties. + UpExpr = node_up_expr(Node), + AnticOut = node_antic_out(Node), + SubIns = node_sub_inserts(Node), + + %% debug_struct("Label: ", Label), + + {HasIns, NewMapsAcc} = + ?SETS:fold(fun(ExprId, {HasInsAcc, MapsAcc2}) -> + Expr = maps_expr_get(ExprId, MapsAcc2), + + ExprIns = expr_inserts(Expr), + ExprSubIns = ?SETS:intersection(ExprIns, SubIns), + + %% There are three cases when to insert an expression + %% 1. The expression is defined at least twice in the subtree of this + %% node, that is length(ExprSubIns) > 1. + %% 2. It is defined in the node and is upwards exposed. + %% 3. The node is a block just above a loop, so we should move + %% all anticipated expressions to the node. + + case length(ExprSubIns) > 1 orelse ?SETS:is_element(ExprId, UpExpr) + orelse node_pre_loop(Node) of + true -> + %% get labels of all sub blocks that inserts the expression and + %% that are dominated by the current node. + Dominates = + ?SETS:filter(fun(SubLabel) -> + hipe_dominators:domTree_dominates(Label, SubLabel, DomTree) + end, ExprSubIns), + + %% remove inserts labels from insert labelset. + NewIns = ?SETS:subtract(ExprIns, Dominates), + NewIns2 = ?SETS:add_element(Label, NewIns), + + %% update the node. + NewMaps = + maps_expr_enter(expr_inserts_set(Expr, NewIns2), MapsAcc2), + {true, NewMaps}; + false -> + {HasInsAcc, MapsAcc2} + end + end, {false, MapsAcc}, ?SETS:union(AnticOut, UpExpr)), + + %% Check if there was an insert into this node, + %% and if so add to the sub inserts set. + NewSubIns = + case HasIns of + true -> + ?SETS:add_element(Label, SubIns); + false -> + SubIns + end, + + %% update sub inserts for all predecessors to the node. + NewNodes2 = + lists:foldl(fun(PredLabel, NodesAcc2) -> + PredNode = get_node(PredLabel, NodesAcc2), + enter_node(node_union_sub_inserts(PredNode, NewSubIns), NodesAcc2) + end, NodesAcc, node_pred(Node)), + + {NewNodes2, NewMapsAcc} + + end, {NodesIn, MapsIn}, nodes_postorder(NodesIn)). + +%%----------------------------------------------------------------------------- +%% Update the insert sets of each node in the node tree. +%% That is, move the insert information from the expressions to +%% the actual nodes that perform the inserts. + +update_nodes_inserts(Nodes, Maps) -> + lists:foldl(fun(Expr, NodesAcc) -> + ExprId = expr_id(Expr), + ?SETS:fold(fun(Label, NsAcc) -> + Nd = get_node(Label, NsAcc), + enter_node(node_add_insert(Nd, ExprId), NsAcc) + end, NodesAcc, expr_inserts(Expr)) + end, Nodes, maps_expr_values(Maps)). + +%%----------------------------------------------------------------------------- +%% Rewrite CFG functions + +%%----------------------------------------------------------------------------- +%% Do the code updating from the info in the nodes and maps structures. This +%% is a proxy function for rewrite_cfg/6 +rewrite_cfg(CFG, Nodes, Maps) -> + {NewCFG, _Visited} = + rewrite_cfg(CFG, ?SETS:new(), #update{}, Nodes, Maps, [nodes_start_label(Nodes)]), + %% debug_struct("Visited: ", _Visited), + NewCFG. + +%%----------------------------------------------------------------------------- +%% rewrite_cfg +%% traverse the CFG in reverse postorder and rewrite each basic block before +%% rewriteing its children. Pass along to each BB update the mappings of +%% inserted expressions in the Update record. + +rewrite_cfg(CFG, Visited, Update, Nodes, Maps, Labels) -> + lists:foldl(fun(Label, {CFGAcc, VisitedAcc}) -> + case ?SETS:is_element(Label, VisitedAcc) of + false -> + %% debug_struct("Visit: ", Label), + Node = get_node(Label, Nodes), + NewVisitedAcc = ?SETS:add_element(Label, VisitedAcc), + {NewCFGAcc, NewUpdate} = rewrite_bb(CFGAcc, Update, Maps, Node), + %% debug_struct("Update inserted: ", update_inserted_list(NewUpdate)), + rewrite_cfg(NewCFGAcc, NewVisitedAcc, NewUpdate, Nodes, Maps, node_succ(Node)); + true -> + {CFGAcc, VisitedAcc} + end + end, {CFG, Visited}, Labels). + +%%----------------------------------------------------------------------------- +%% rewrite one single basic block in the CFG as described by the properties +%% in the Node for that block. Uses the Maps and Update info to lookup +%% the instructions and expressions to insert or delete. + +rewrite_bb(CFG, Update, Maps, Node) -> + #node{pre_loop = PreLoop, label = Label, up_expr = UpExpr, inserts = Inserts} = Node, + + Code = hipe_bb:code(hipe_icode_cfg:bb(CFG, Label)), + + %debug_struct("RW Label: ", Label), + %debug_struct("Inserts", Inserts), + + DelRed = update_del_red_test(Update), + Delete = ?SETS:subtract(UpExpr, Inserts), + + %% local function that gets the instruction and defines list of an + %% expression id in the current node and and returns them. + GetInstrFunc = fun(Expr) -> + Instr = expr_key(Expr), + Defs = expr_defs(Expr), + NewInstr = + if + PreLoop -> + replace_call_variables(fun(Var) -> + node_varmap_lookup(Node, + Var) + end, + Instr); + true -> + Instr + end, + {NewInstr, Defs} + end, + + %% go through all expressions defined by the node and replace + %% or remove them as indicated by the delete set. Also perform + %% reduction test replacement if neccessary. + {[CodeLast | CodeRest], NewUpdate, LocalAcc} = + lists:foldl(fun(Instr, {CodeAcc, UpdateAcc, LocalAcc}) -> + case struct_instr_type(Instr) of + struct -> + Defs = hipe_icode:defines(Instr), + + #varinfo{exprid = ExprId} = maps_var_get(hd(Defs), Maps), + + Expr = maps_expr_get(ExprId, Maps), + DirectReplace = expr_direct_replace(Expr), + + %% Creates move intstructions from Vars to Defs + RemoveFuncVars = fun(Vars) -> + CodeAcc2 = mk_defs_moves(CodeAcc, Defs, Vars), + {CodeAcc2, UpdateAcc, LocalAcc} end, + + %% Looks up an already inserted ExprId and makes moves + %% of variables from that expression to this expression. + RemoveFunc = fun() -> + {value, Vars} = update_inserted_lookup(UpdateAcc, ExprId), + RemoveFuncVars(Vars) end, + + %% Is ExprId already inserted? + IsLocal = ?SETS:is_element(ExprId, LocalAcc), + + case DirectReplace of + true -> + %% The Instr is reffering to an expression that is + %% defined as an identical already present instruction, + %% and can be removed directly. + RemoveFuncVars(expr_defs(Expr)); + false when IsLocal -> + %% The instruction has already been inserted. + RemoveFunc(); + _ -> + case ?SETS:is_element(ExprId, Delete) of + true -> + %% should not be inserted + RemoveFunc(); + _ -> + %% Should remain + UpdateAcc2 = update_inserted_add(UpdateAcc, ExprId, Defs), + LocalAcc2 = ?SETS:add_element(ExprId, LocalAcc), + {[Instr | CodeAcc], UpdateAcc2, LocalAcc2} + end + end; + redtest when DelRed -> + %% delete reduction test + {CodeAcc, UpdateAcc, LocalAcc}; + _ -> + {[Instr | CodeAcc], UpdateAcc, LocalAcc} + end + end, {[], Update, ?SETS:new()}, Code), + + %debug_struct("RW Label 2: ", Label), + + %% calculate the inserts that are new to this node, that is + %% the expressions that are in Inserts but not in UpExpr, + %% and that have not been added already, + %% that is not present in LocalAcc + NewInserts = ?SETS:subtract(?SETS:subtract(Inserts, UpExpr), LocalAcc), + + {NewCodeRest, NewUpdate2} = + ?SETS:fold(fun(ExprId, {CodeAcc, UpdateAcc}) -> + Expr = maps_expr_get(ExprId, Maps), + {ExprInstr, Defs} = GetInstrFunc(Expr), + {UpdateAcc2, NewDefs} = update_inserted_add_new(UpdateAcc, ExprId, Defs), + + %% check if there exists an identical expression, so that + %% this expression can be replaced directly. + CodeAcc2 = + case expr_direct_replace(Expr) of + false -> + NewInstr = rewrite_expr(UpdateAcc2, ExprInstr, NewDefs), + [NewInstr | CodeAcc]; + true -> + mk_defs_moves(CodeAcc, NewDefs, Defs) + end, + {CodeAcc2, UpdateAcc2} + end, {CodeRest, NewUpdate}, NewInserts), + + NewCode = lists:reverse([CodeLast | NewCodeRest]), + + %% Check if we are to insert new reduction test here... + {NewCode2, NewUpdate3} = + case PreLoop andalso ?SETS:size(Inserts) > 0 andalso not DelRed of + true -> + {[hipe_icode:mk_primop([], redtest, []) | NewCode], update_del_red_test_set(NewUpdate2)}; + false -> + {NewCode, NewUpdate2} + end, + + NewBB = hipe_bb:mk_bb(NewCode2), + NewCFG = hipe_icode_cfg:bb_add(CFG, Label, NewBB), + + {NewCFG, NewUpdate3}. + +%%----------------------------------------------------------------------------- +%% Create a new structure instruction from Instr with destination Defs +%% from the insert mapping in Update. + +rewrite_expr(Update, Instr, Defs) -> + NewInstr = + replace_call_variables(fun(Ref) -> + case Ref of + {ExprId, Num} when is_integer(ExprId) -> + {value, DefList} = update_inserted_lookup(Update, ExprId), + lists:nth(Num, DefList); + _ -> Ref + end end, Instr), + hipe_icode:call_dstlist_update(NewInstr, Defs). + +%%----------------------------------------------------------------------------- +%% Make move instructions from Defs list to all variables in +%% the Refs list and insert into Code. + +mk_defs_moves(Code, [], []) -> Code; +mk_defs_moves(Code, [Ref | Refs], [Def | Defs]) -> + mk_defs_moves([hipe_icode:mk_move(Ref, Def) | Code], Refs, Defs). + +%%----------------------------------------------------------------------------- +%% Utilities + +new_work() -> + {[], gb_sets:new()}. + +add_work_list(List, Work) -> + lists:foldl(fun(Label, WorkAcc) -> + add_work_label(Label, WorkAcc) end, Work, List). + +add_work_label(Label, {List, Set}) -> + case gb_sets:is_member(Label, Set) of + false -> + {[Label | List], gb_sets:add(Label, Set)}; + true -> + {List, Set} + end. + +get_work_list({List, _}) -> + lists:reverse(List). + +%%----------------------------------------------------------------------------- +%% instr_type +%% gets a tag for the type of instruction that is passed in I + +struct_instr_type(I) -> + case I of + #icode_call{type = primop, 'fun' = mktuple} -> + %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = mktuple}), + struct; + #icode_call{type = primop, 'fun' = cons} -> + %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = cons}), + struct; + #icode_call{type = primop, 'fun' = redtest} -> + %%debug_count_case(?SR_STRUCT_INSTR_TYPE, #call{type = primop, 'fun' = redtest}), + redtest; + _ -> + %%debug_count_case(?SR_STRUCT_INSTR_TYPE, other), + other + end. + +instr_type(I) -> + case I of + %#call{type = primop, dstlist = List} when length(List) >= 1 -> struct; + #icode_call{type = primop, 'fun' = {unsafe_element, Elem}, dstlist = [DstVar], args = [SrcVar]} -> + %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = {unsafe_element, num}}), + {struct_elems, Elem, DstVar, SrcVar}; + #icode_phi{} -> + %%debug_count_case(?SR_INSTR_TYPE,#phi{}), + phi; + #icode_enter{} -> + %%debug_count_case(?SR_INSTR_TYPE,#enter{}), + return; + #icode_return{} -> + %%debug_count_case(?SR_INSTR_TYPE,#return{}), + return; + #icode_call{type = primop, 'fun' = mktuple} -> + %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = mktuple}), + struct; + #icode_call{type = primop, 'fun' = cons} -> + %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = cons}), + struct; + #icode_call{type = primop, 'fun' = redtest} -> + %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = redtest}), + redtest; + #icode_type{test = {tuple, Size}, args = [Var]} -> + %%debug_count_case(?SR_INSTR_TYPE, #type{type = {tuple, size}}), + {struct_type, Size, Var, ?MKTUPLE}; + #icode_type{test = cons, args = [Var]} -> + %%debug_count_case(?SR_INSTR_TYPE,#type{type = cons}), + {struct_type, 2, Var, ?CONS}; + %#type{type = {atom, Atom}, args = [Var]} -> {atom_type, Atom, Var}; + #icode_call{type = primop, 'fun' = unsafe_hd, + dstlist = [DstVar], args = [SrcVar]} -> + %%debug_count_case(?SR_INSTR_TYPE,#call{type = primop, 'fun' = unsafe_hd}), + {struct_elems, 1, DstVar, SrcVar}; + #icode_call{type = primop, 'fun' = unsafe_tl, + dstlist = [DstVar], args = [SrcVar]} -> + %%debug_count_case(?SR_INSTR_TYPE, #call{type = primop, 'fun' = unsafe_tl}), + {struct_elems, 2, DstVar, SrcVar}; + #icode_switch_tuple_arity{term = Var, cases = Cases} -> + %%debug_count_case(?SR_INSTR_TYPE,#switch_tuple_arity{}), + {tuple_arity, Var, Cases}; + _ -> other + end. + +%%----------------------------------------------------------------------------- +%% Expression ID counter + +init_expr_id() -> + put({struct_reuse, expr_id_count}, 0). + +-spec new_expr_id() -> non_neg_integer(). +new_expr_id() -> + V = get({struct_reuse, expr_id_count}), + put({struct_reuse, expr_id_count}, V+1), + V. + +%%----------------------------------------------------------------------------- +%% Debug and print functions + +print_struct(String, Struct) -> + io:format(String), + erlang:display(Struct). + +print(String) -> + io:format(String). + +-ifdef(DEBUG). + +debug_count_case(Type, Case) -> + Cases = get(Type), + NewCases = + case gb_trees:lookup(Case, Cases) of + {value, Value} -> gb_trees:enter(Case, Value + 1, Cases); + none -> gb_trees:insert(Case, 1, Cases) + end, + put(Type, NewCases). + +debug_init_case_count(Type) -> + case get(Type) of + undefined -> put(Type, gb_trees:empty()); + _ -> ok + end. + +debug_print_case_count(Type) -> + Cases = get(Type), + debug_struct("Case type: ", Type), + debug_list("Cases: ", gb_trees:to_list(Cases)). + +set_debug_flag(Value) -> + put({struct_reuse, debug}, Value). + +get_debug_flag() -> get({struct_reuse, debug}). + +debug_function(FuncName, CFG) -> + Linear = hipe_icode_cfg:cfg_to_linear(CFG), + Func = hipe_icode:icode_fun(Linear), + case Func =:= FuncName orelse FuncName =:= nil of + true -> + set_debug_flag(true), + %% debug_struct("Code: ", hipe_icode_cfg:bb(CFG, 15)), + debug_struct("~nFunction name :", Func); + false -> + set_debug_flag(undefined) + end. + +debug_cfg_pp(CFG) -> + case get_debug_flag() of + true -> hipe_icode_cfg:pp(CFG); + _ -> none + end. + +debug_struct(String, Struct) -> + case get_debug_flag() of + true -> + io:format(String), + erlang:display(Struct); + _ -> none + end. + +debug(String) -> + case get_debug_flag() of + true -> io:format(String); + _ -> none + end. + +debug_list(String, List) -> + case get_debug_flag() of + true -> print_list(String, List); + _ -> none + end. + +print_list(String, List) -> + io:format(String), + io:format("~n"), + print_list_rec(List), + io:format("~n"). + +print_list_rec([]) -> ok; +print_list_rec([Struct | List]) -> + erlang:display(Struct), + print_list_rec(List). + +debug_nodes(Nodes) -> + lists:foreach(fun(Node) -> debug_node(Node) end, nodes_tree_values(Nodes)). + +debug_node(Node) -> + case get_debug_flag() of + true -> + print_struct("Node Label: ", Node#node.label), + print_struct("Code: ", Node#node.code), + print_struct("Phi: ", Node#node.phi), + print_struct("PreLoop: ", Node#node.pre_loop), + print_struct("Preds: ", Node#node.pred), + print_struct("Succ: ", Node#node.succ), + print_struct("Up Expr: ", Node#node.up_expr), + print_struct("Kill : ", Node#node.killed_expr), + print_struct("AnticIn: ", Node#node.antic_in), + print_struct("AnticOut: ", Node#node.antic_out), + print_struct("SubInserts: ", Node#node.sub_inserts), + print_struct("Inserts: ", Node#node.inserts), + print_struct("NonStructDefs: ", Node#node.non_struct_defs), + print_struct("Params: ", Node#node.struct_type), + print_struct("Elems: ", Node#node.struct_elems), + io:format("~n"); + _ -> none + end. + +-endif. diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl new file mode 100644 index 0000000000..28198467f7 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -0,0 +1,2266 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-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_icode_type.erl +%%% Author : Tobias Lindahl +%%% Description : Propagate type information. +%%% +%%% Created : 25 Feb 2003 by Tobias Lindahl +%%% +%%% $Id$ +%%%-------------------------------------------------------------------- + +-module(hipe_icode_type). + +-export([cfg/4, unannotate_cfg/1, specialize/1]). + +%%===================================================================== +%% Icode Coordinator Callbacks +%%===================================================================== + +-export([replace_nones/1, + update__info/2, new__info/1, return__info/1, + return_none/0, return_none_args/2, return_any_args/2]). + +%%===================================================================== + +-include("../main/hipe.hrl"). +-include("hipe_icode.hrl"). +-include("hipe_icode_primops.hrl"). +-include("hipe_icode_type.hrl"). +-include("../flow/cfg.hrl"). + +-type args_fun() :: fun((mfa(), cfg()) -> [erl_types:erl_type()]). +-type call_fun() :: fun((mfa(), [_]) -> erl_types:erl_type()). +-type final_fun() :: fun((mfa(), [_]) -> 'ok'). +-type data() :: {mfa(), args_fun(), call_fun(), final_fun()}. + +%-define(DO_HIPE_ICODE_TYPE_TEST, false). + +-ifdef(DO_HIPE_ICODE_TYPE_TEST). +-export([test/0]). +-endif. + +-define(MFA_debug, fun(_, _, _) -> ok end). + +%-define(debug, fun(X, Y) -> io:format("~s ~p~n", [X, Y]) end). +-define(debug, fun(_, _) -> ok end). + +%-define(flow_debug, fun(X, Y) -> io:format("flow: ~s ~p~n", [X, Y]) end). +-define(flow_debug, fun(_, _) -> ok end). + +%-define(widening_debug, fun(X, Y) -> io:format("wid: ~s ~p~n", [X, Y]) end). +-define(widening_debug, fun(_, _) -> ok end). + +%-define(call_debug, fun(X, Y) -> io:format("call: ~s ~p~n", [X, Y]) end). +-define(call_debug, fun(_, _) -> ok end). + +%-define(ineq_debug, fun(X, Y) -> io:format("ineq: ~s ~p~n", [X, Y]) end). +-define(ineq_debug, fun(_, _) -> ok end). + +%-define(server_debug, fun(X, Y) -> io:format("~p server: ~s ~p~n", [self(), X, Y]) end). +-define(server_debug, fun(_, _) -> ok end). + +-import(erl_types, [min/2, max/2, number_min/1, number_max/1, + t_any/0, t_atom/1, t_atom/0, t_atom_vals/1, + t_binary/0, t_bitstr/0, t_bitstr_base/1, t_bitstr_unit/1, + t_boolean/0, t_cons/0, t_constant/0, + t_float/0, t_from_term/1, t_from_range/2, + t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_arity/1, + t_inf/2, t_inf_lists/2, t_integer/0, + t_integer/1, t_is_atom/1, t_is_any/1, + t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, t_is_boolean/1, + t_is_fixnum/1, t_is_cons/1, t_is_constant/1, + t_is_maybe_improper_list/1, t_is_equal/2, t_is_float/1, + t_is_fun/1, t_is_integer/1, t_is_non_neg_integer/1, + t_is_number/1, t_is_matchstate/1, + t_is_nil/1, t_is_none/1, t_is_port/1, t_is_pid/1, + t_is_reference/1, t_is_subtype/2, t_is_tuple/1, + t_limit/2, t_matchstate_present/1, t_matchstate/0, + t_matchstate_slots/1, t_maybe_improper_list/0, + t_nil/0, t_none/0, t_number/0, t_number/1, t_number_vals/1, + t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2, + t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]). + +-record(state, {info_map = gb_trees:empty() :: gb_tree(), + cfg :: cfg(), + liveness = gb_trees:empty() :: gb_tree(), + arg_types :: [erl_types:erl_type()], + ret_type = [t_none()] :: [erl_types:erl_type()], + lookupfun :: call_fun(), + resultaction :: final_fun()}). + +%%----------------------------------------------------------------------- +%% The main exported function +%%----------------------------------------------------------------------- + +-spec cfg(cfg(), mfa(), comp_options(), #comp_servers{}) -> cfg(). + +cfg(Cfg, MFA, Options, Servers) -> + case proplists:get_bool(concurrent_comp, Options) of + true -> + concurrent_cfg(Cfg, MFA, Servers#comp_servers.type); + false -> + ordinary_cfg(Cfg, MFA) + end. + +concurrent_cfg(Cfg, MFA, CompServer) -> + CompServer ! {ready, {MFA, self()}}, + {ArgsFun, CallFun, FinalFun} = do_analysis(Cfg, MFA), + Ans = do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun), + CompServer ! {done_rewrite, MFA}, + Ans. + +do_analysis(Cfg, MFA) -> + receive + {analyse, {ArgsFun,CallFun,FinalFun}} -> + analyse(Cfg, {MFA,ArgsFun,CallFun,FinalFun}), + do_analysis(Cfg, MFA); + {done, {_NewArgsFun,_NewCallFun,_NewFinalFun} = Done} -> + Done + end. + +do_rewrite(Cfg, MFA, ArgsFun, CallFun, FinalFun) -> + common_rewrite(Cfg, {MFA,ArgsFun,CallFun,FinalFun}). + +ordinary_cfg(Cfg, MFA) -> + Data = make_data(Cfg,MFA), + common_rewrite(Cfg, Data). + +common_rewrite(Cfg, Data) -> + State = safe_analyse(Cfg, Data), + NewState = simplify_controlflow(State), + NewCfg = state__cfg(annotate_cfg(NewState)), + hipe_icode_cfg:remove_unreachable_code(specialize(NewCfg)). + +make_data(Cfg, {_M,_F,A}=MFA) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg); + false -> A + end, + Args = lists:duplicate(NoArgs, t_any()), + ArgsFun = fun(_,_) -> Args end, + CallFun = fun(_,_) -> t_any() end, + FinalFun = fun(_,_) -> ok end, + {MFA,ArgsFun,CallFun,FinalFun}. + +%%debug_make_data(Cfg, {_M,_F,A}=MFA) -> +%% NoArgs = +%% case hipe_icode_cfg:is_closure(Cfg) of +%% true -> hipe_icode_cfg:closure_arity(Cfg); +%% false -> A +%% end, +%% Args = lists:duplicate(NoArgs, t_any()), +%% ArgsFun = fun(MFA,_Cfg) -> io:format("Start:~p~n",[MFA]),Args end, +%% CallFun = fun(MFA,Types) -> io:format("Call With:~p~nTo:~p~n",[Types,MFA]), t_any() end, +%% FinalFun = fun(MFA,Type) -> io:format("ResType:~p~nFor:~p~n",[Type,MFA]),ok end, +%% {MFA,ArgsFun,CallFun,FinalFun}. + + +%%------------------------------------------------------------------- +%% Global type analysis on the whole function. Demands that the code +%% is in SSA form. When we encounter a phi node, the types of the +%% arguments are joined. At the end of a block the information out is +%% joined with the current information in for all _valid_ successors, +%% that is, of all successors that actually can be reached. If the +%% join produces new information in for the successor, this +%% information is added to the worklist. +%%------------------------------------------------------------------- + +-spec analyse(cfg(), data()) -> 'ok'. + +analyse(Cfg, Data) -> + try + #state{} = safe_analyse(Cfg, Data), + ok + catch throw:no_input -> ok % No need to do anything since we have no input + end. + +-spec safe_analyse(cfg(), data()) -> #state{}. + +safe_analyse(Cfg, {MFA,_,_,_}=Data) -> + State = new_state(Cfg, Data), + NewState = analyse_blocks(State,MFA), + (state__resultaction(NewState))(MFA,state__ret_type(NewState)), + NewState. + +analyse_blocks(State, MFA) -> + Work = init_work(State), + analyse_blocks(Work, State, MFA). + +analyse_blocks(Work, State, MFA) -> + case get_work(Work) of + fixpoint -> + State; + {Label, NewWork} -> + Info = state__info_in(State, Label), + {NewState, NewLabels} = + try analyse_block(Label, Info, State) + catch throw:none_type -> + %% io:format("received none type at label: ~p~n",[Label]), + {State,[]} + end, + NewWork2 = add_work(NewWork, NewLabels), + analyse_blocks(NewWork2, NewState, MFA) + end. + +analyse_block(Label, InfoIn, State) -> + BB = state__bb(State, Label), + Code = hipe_bb:butlast(BB), + Last = hipe_bb:last(BB), + InfoOut = analyse_insns(Code, InfoIn, state__lookupfun(State)), + NewState = state__info_out_update(State, Label, InfoOut), + case Last of + #icode_if{} -> + UpdateInfo = do_if(Last, InfoOut), + do_updates(NewState, UpdateInfo); + #icode_type{} -> + UpdateInfo = do_type(Last, InfoOut), + do_updates(NewState, UpdateInfo); + #icode_switch_tuple_arity{} -> + UpdateInfo = do_switch_tuple_arity(Last, InfoOut), + do_updates(NewState, UpdateInfo); + #icode_switch_val{} -> + UpdateInfo = do_switch_val(Last, InfoOut), + do_updates(NewState, UpdateInfo); + #icode_enter{} -> + NewState1 = do_enter(Last, InfoOut, NewState, state__lookupfun(NewState)), + do_updates(NewState1,[]); + #icode_call{} -> + {NewState1,UpdateInfo} = do_last_call(Last, InfoOut, NewState, Label), + do_updates(NewState1, UpdateInfo); + #icode_return{} -> + NewState1 = do_return(Last, InfoOut, NewState), + do_updates(NewState1,[]); + _ -> + UpdateInfo = [{X, InfoOut} || X <- state__succ(NewState, Label)], + do_updates(NewState, UpdateInfo) + end. + +analyse_insns([I|Insns], Info, LookupFun) -> + NewInfo = analyse_insn(I, Info, LookupFun), + analyse_insns(Insns, NewInfo, LookupFun); +analyse_insns([], Info, _) -> + Info. + +analyse_insn(I, Info, LookupFun) -> + case I of + #icode_move{} -> + do_move(I, Info); + #icode_call{} -> + NewInfo = do_call(I, Info, LookupFun), + %%io:format("Analysing Call: ~w~n~w~n", [I,NewInfo]), + update_call_arguments(I, NewInfo); + #icode_phi{} -> + Type = t_limit(join_list(hipe_icode:args(I), Info), ?TYPE_DEPTH), + enter_defines(I, Type, Info); + #icode_begin_handler{} -> + enter_defines(I, t_any(), Info); + _ -> + %% Just an assert + case defines(I) of + [] -> Info; + _ -> exit({"Instruction with destination not analysed", I}) + end + end. + +do_move(I, Info) -> + %% Can't use uses/1 since we must keep constants. + [Src] = hipe_icode:args(I), + enter_defines(I, lookup(Src, Info), Info). + +do_basic_call(I, Info, LookupFun) -> + case hipe_icode:call_type(I) of + primop -> + Fun = hipe_icode:call_fun(I), + ArgTypes = lookup_list(hipe_icode:args(I), Info), + primop_type(Fun, ArgTypes); + remote -> + {M, F, A} = hipe_icode:call_fun(I), + ArgTypes = lookup_list(hipe_icode:args(I), Info), + None = t_none(), + case erl_bif_types:type(M, F, A, ArgTypes) of + None -> + NewArgTypes = add_funs_to_arg_types(ArgTypes), + erl_bif_types:type(M, F, A, NewArgTypes); + Other -> + Other + end; + local -> + MFA = hipe_icode:call_fun(I), + ArgTypes = lookup_list(hipe_icode:args(I), Info), + %% io:format("Call:~p~nTypes: ~p~n",[I,ArgTypes]), + LookupFun(MFA,ArgTypes) + end. + +do_call(I, Info, LookupFun) -> + RetType = do_basic_call(I, Info, LookupFun), + IsNone = t_is_none(RetType), + %% io:format("RetType ~p~nIsNone ~p~n~p~n",[RetType,IsNone,I]), + if IsNone -> throw(none_type); + true -> enter_defines(I, RetType, Info) + end. + +do_safe_call(I, Info, LookupFun) -> + RetType = do_basic_call(I, Info, LookupFun), + enter_defines(I, RetType, Info). + +do_last_call(Last, InfoOut, State, Label) -> + try + NewInfoOut = do_call(Last, InfoOut, state__lookupfun(State)), + NewState = state__info_out_update(State, Label, NewInfoOut), + ContInfo = update_call_arguments(Last, NewInfoOut), + Cont = hipe_icode:call_continuation(Last), + Fail = hipe_icode:call_fail_label(Last), + ?call_debug("Continfo, NewInfoOut", {ContInfo, NewInfoOut}), + UpdateInfo = + case Fail of + [] -> + [{Cont, ContInfo}]; + _ -> + case call_always_fails(Last, InfoOut) of + true -> + [{Fail, NewInfoOut}]; + false -> + Fun = hipe_icode:call_fun(Last), + case hipe_icode_primops:fails(Fun) of + true -> + [{Cont, ContInfo}, {Fail, NewInfoOut}]; + false -> + [{Cont, ContInfo}] + end + end + end, + {NewState,UpdateInfo} + catch throw:none_type -> + State2 = state__info_out_update(State, Label, InfoOut), + case hipe_icode:call_fail_label(Last) of + [] -> throw(none_type); + FailLbl -> + {State2,[{FailLbl, InfoOut}]} + end + end. + +call_always_fails(#icode_call{} = I, Info) -> + case hipe_icode:call_fun(I) of + %% These can actually be calls too. + {erlang, halt, 0} -> false; + {erlang, halt, 1} -> false; + {erlang, exit, 1} -> false; + {erlang, error, 1} -> false; + {erlang, error, 2} -> false; + {erlang, throw, 1} -> false; + {erlang, hibernate, 3} -> false; + Fun -> + case hipe_icode:call_type(I) of + primop -> + Args = safe_lookup_list(hipe_icode:call_args(I), Info), + ReturnType = primop_type(Fun, Args), + t_is_none(ReturnType); + _ -> false + end + end. + +do_enter(I, Info, State, LookupFun) -> + %% io:format("Enter:~p~n",[I]), + ArgTypes = lookup_list(hipe_icode:args(I), Info), + RetTypes = + case hipe_icode:enter_type(I) of + local -> + MFA = hipe_icode:enter_fun(I), + LookupFun(MFA,ArgTypes); + remote -> + {M, F, A} = hipe_icode:enter_fun(I), + None = t_none(), + case erl_bif_types:type(M, F, A, ArgTypes) of + None -> + NewArgTypes = add_funs_to_arg_types(ArgTypes), + erl_bif_types:type(M, F, A, NewArgTypes); + Other -> + Other + end; + primop -> + Fun = hipe_icode:enter_fun(I), + primop_type(Fun, ArgTypes) + end, + state__ret_type_update(State, RetTypes). + +do_return(I, Info, State) -> + RetTypes = lookup_list(hipe_icode:args(I), Info), + state__ret_type_update(State, RetTypes). + +do_if(I, Info) -> + %% XXX: Could probably do better than this. + TrueLab = hipe_icode:if_true_label(I), + FalseLab = hipe_icode:if_false_label(I), + case hipe_icode:if_args(I) of + [Arg1, Arg2] = Args -> + [Type1, Type2] = lookup_list(Args, Info), + case t_is_none(Type1) orelse t_is_none(Type2) of + true -> + [{TrueLab, Info}, {FalseLab, Info}]; + false -> + Inf = t_inf(Type1, Type2), + case hipe_icode:if_op(I) of + '=:='-> + case t_is_none(Inf) of + true -> + [{FalseLab, Info}]; + false -> + [{TrueLab, enter(Arg1, Inf, enter(Arg2, Inf, Info))}, + {FalseLab, Info}] + end; + '=/=' -> + case t_is_none(Inf) of + true -> + [{TrueLab, Info}]; + false -> + [{FalseLab, enter(Arg1, Inf, enter(Arg2, Inf, Info))}, + {TrueLab, Info}] + end; + '==' -> + [{TrueLab, Info}, {FalseLab, Info}]; + '/=' -> + [{TrueLab, Info}, {FalseLab, Info}]; + Op -> + integer_range_inequality_propagation(Op, Arg1, Arg2, + TrueLab, FalseLab, Info) + %%_ -> + %% [{TrueLab, Info}, {FalseLab, Info}] + end + end; + _ -> + %% Only care for binary if:s + [{TrueLab, Info}, {FalseLab, Info}] + end. + +integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> + Arg1 = lookup(A1, Info), + Arg2 = lookup(A2, Info), + ?ineq_debug("args", [Arg1,Arg2]), + IntArg1 = t_inf(Arg1, t_integer()), + IntArg2 = t_inf(Arg2, t_integer()), + NonIntArg1 = t_subtract(Arg1, t_integer()), + NonIntArg2 = t_subtract(Arg2, t_integer()), + ?ineq_debug("nonintargs", [NonIntArg1,NonIntArg2]), + case t_is_none(IntArg1) or t_is_none(IntArg2) of + true -> + ?ineq_debug("one is none", [IntArg1,IntArg2]), + [{TrueLab, Info}, {FalseLab, Info}]; + false -> + case Op of + '>=' -> + {FalseArg1, FalseArg2, TrueArg1, TrueArg2} = + integer_range_less_then_propagator(IntArg1, IntArg2); + '>' -> + {TrueArg2, TrueArg1, FalseArg2, FalseArg1} = + integer_range_less_then_propagator(IntArg2, IntArg1); + '<' -> + {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = + integer_range_less_then_propagator(IntArg1, IntArg2); + '=<' -> + {FalseArg2, FalseArg1, TrueArg2, TrueArg1} = + integer_range_less_then_propagator(IntArg2, IntArg1) + end, + ?ineq_debug("int res", [TrueArg1, TrueArg2, FalseArg1, FalseArg2]), + False = {FalseLab, enter(A1, t_sup(FalseArg1, NonIntArg1), + enter(A2, t_sup(FalseArg2, NonIntArg2), Info))}, + True = {TrueLab, enter(A1, t_sup(TrueArg1, NonIntArg1), + enter(A2, t_sup(TrueArg2, NonIntArg2), Info))}, + [True, False] + end. + +integer_range_less_then_propagator(IntArg1, IntArg2) -> + Min1 = number_min(IntArg1), + Max1 = number_max(IntArg1), + Min2 = number_min(IntArg2), + Max2 = number_max(IntArg2), + %% is this the same as erl_types:t_subtract?? no ... ?? + TrueMax1 = min(Max1, erl_bif_types:infinity_add(Max2, -1)), + TrueMin2 = max(erl_bif_types:infinity_add(Min1, 1), Min2), + FalseMin1 = max(Min1, Min2), + FalseMax2 = min(Max1, Max2), + {t_from_range(Min1, TrueMax1), + t_from_range(TrueMin2, Max2), + t_from_range(FalseMin1, Max1), + t_from_range(Min2, FalseMax2)}. + +do_type(I, Info) -> + case hipe_icode:args(I) of + [Var] -> do_type(I, Info, Var); + [Var1,Var2] -> do_type2(I, Info, Var1, Var2) + end. + +do_type2(I, Info, FunVar, ArityVar) -> % function2(Fun,Arity) + %% Just for sanity. + function2 = hipe_icode:type_test(I), + FunType = lookup(FunVar, Info), + ArityType = lookup(ArityVar, Info), + TrueLab = hipe_icode:type_true_label(I), + FalseLab = hipe_icode:type_false_label(I), + SuccType1 = t_inf(t_fun(), FunType), + case combine_test(test_type(function, FunType), + test_type(integer, ArityType)) of + true -> + case t_number_vals(ArityType) of + [Arity] -> + case t_fun_arity(SuccType1) of + unknown -> + SuccType = t_inf(t_fun(Arity,t_any()),FunType), + [{TrueLab, enter(FunVar, SuccType, Info)}, + {FalseLab, Info}]; + Arity when is_integer(Arity) -> + FalseType = t_subtract(FunType, t_fun(Arity, t_any())), + [{TrueLab, enter(FunVar, SuccType1, Info)}, + {FalseLab, enter(FunVar, FalseType, Info)}] + end; + _ -> + case t_fun_arity(SuccType1) of + unknown -> + [{TrueLab, enter(FunVar,SuccType1,Info)}, + {FalseLab, Info}]; + Arity when is_integer(Arity) -> + T = t_from_term(Arity), + NewInfo = enter(ArityVar, T, Info), + [{TrueLab, enter(FunVar, SuccType1, NewInfo)}, + {FalseLab, enter(ArityVar, t_subtract(T, ArityType), Info)}] + end + end; + false -> + [{FalseLab, Info}]; + maybe -> + GenTrueArity = t_inf(t_integer(), ArityType), + GenTrueFun = t_inf(t_fun(), FunType), + case {t_number_vals(GenTrueArity), t_fun_arity(GenTrueFun)} of + {unknown, unknown} -> + TrueInfo = enter_list([FunVar, ArityVar], + [GenTrueFun, GenTrueArity], Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}]; + {unknown, Arity} when is_integer(Arity) -> + TrueInfo = enter_list([FunVar, ArityVar], + [GenTrueFun, t_integer(Arity)], Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}]; + {[Val], unknown} when is_integer(Val) -> + TrueInfo = enter_list([FunVar, ArityVar], + [t_inf(GenTrueFun, t_fun(Val, t_any())), + GenTrueArity], Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}]; + {Vals, unknown} when is_list(Vals) -> + %% The function type gets widened when we have more than one arity. + TrueInfo = enter_list([FunVar, ArityVar], + [GenTrueFun, GenTrueArity], Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}]; + {Vals, Arity} when is_list(Vals), is_integer(Arity) -> + case lists:member(Arity, Vals) of + false -> + [{FalseLab, Info}]; + true -> + TrueInfo = enter_list([FunVar, ArityVar], + [GenTrueFun, t_integer(Arity)], Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}] + end + end + end. + +combine_test(true, true) -> true; +combine_test(false, _) -> false; +combine_test(_, false) -> false; +combine_test(_, _) -> maybe. + +do_type(I, Info, Var) -> + TrueLab = hipe_icode:type_true_label(I), + FalseLab = hipe_icode:type_false_label(I), + None = t_none(), + + case lookup(Var, Info) of + None -> + [{TrueLab, Info}, {FalseLab, Info}]; + VarInfo -> + case hipe_icode:type_test(I) of + cons -> + test_cons_or_nil(t_cons(), Var, VarInfo, TrueLab, FalseLab, Info); + nil -> + test_cons_or_nil(t_nil(), Var, VarInfo, TrueLab, FalseLab, Info); + {atom, A} = Test -> + test_number_or_atom(fun(X) -> t_atom(X) end, + A, Var, VarInfo, Test, TrueLab, FalseLab, Info); + {integer, N} = Test -> + test_number_or_atom(fun(X) -> t_number(X) end, + N, Var, VarInfo, Test, TrueLab, FalseLab, Info); + {record, Atom, Size} -> + test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info); + Other -> + case t_is_any(VarInfo) of + true -> + TrueType = t_inf(true_branch_info(Other), VarInfo), + TrueInfo = enter(Var, TrueType, Info), + [{TrueLab, TrueInfo}, {FalseLab, Info}]; + false -> + case test_type(Other, VarInfo) of + true -> + [{TrueLab, Info}]; + false -> + [{FalseLab, Info}]; + maybe -> + TrueType = t_inf(true_branch_info(Other), VarInfo), + TrueInfo = enter(Var, TrueType, Info), + FalseType = t_subtract(VarInfo, TrueType), + FalseInfo = enter(Var, FalseType, Info), + [{TrueLab, TrueInfo}, {FalseLab, FalseInfo}] + end + end + end + end. + +do_switch_tuple_arity(I, Info) -> + Var = hipe_icode:switch_tuple_arity_term(I), + VarType = lookup(Var, Info), + Cases = hipe_icode:switch_tuple_arity_cases(I), + FailLabel = hipe_icode:switch_tuple_arity_fail_label(I), + case legal_switch_tuple_arity_cases(Cases, VarType) of + [] -> + [{FailLabel, Info}]; + LegalCases -> + {Fail, UpdateInfo} = + switch_tuple_arity_update_info(LegalCases, Var, VarType, + FailLabel, VarType, Info, []), + case switch_tuple_arity_can_fail(LegalCases, VarType) of + true -> [Fail|UpdateInfo]; + false -> UpdateInfo + end + end. + +legal_switch_tuple_arity_cases(Cases, Type) -> + case t_is_tuple(Type) of + false -> + Inf = t_inf(t_tuple(), Type), + case t_is_tuple(Inf) of + true -> legal_switch_tuple_arity_cases_1(Cases, Inf); + false -> [] + end; + true -> + legal_switch_tuple_arity_cases_1(Cases, Type) + end. + +legal_switch_tuple_arity_cases_1(Cases, Type) -> + case t_tuple_sizes(Type) of + unknown -> + Cases; + TupleSizes -> + [Case || {Size, _Label} = Case <- Cases, + lists:member(hipe_icode:const_value(Size), TupleSizes)] + end. + +switch_tuple_arity_can_fail(LegalCases, ArgType) -> + case t_is_tuple(ArgType) of + false -> true; + true -> + case t_tuple_sizes(ArgType) of + unknown -> true; + Sizes1 -> + Sizes2 = [hipe_icode:const_value(X) || {X, _} <- LegalCases], + Set1 = sets:from_list(Sizes1), + Set2 = sets:from_list(Sizes2), + not sets:is_subset(Set1, Set2) + end + end. + +switch_tuple_arity_update_info([{Arity, Label}|Left], Var, TupleType, + FailLabel, FailType, Info, Acc) -> + Inf = t_inf(TupleType, t_tuple(hipe_icode:const_value(Arity))), + NewInfo = enter(Var, Inf, Info), + NewFailType = t_subtract(FailType, Inf), + switch_tuple_arity_update_info(Left, Var, TupleType, FailLabel, NewFailType, + Info, [{Label, NewInfo}|Acc]); +switch_tuple_arity_update_info([], Var, _TupleType, + FailLabel, FailType, Info, Acc) -> + {{FailLabel, enter(Var, FailType, Info)}, Acc}. + +do_switch_val(I, Info) -> + Var = hipe_icode:switch_val_term(I), + VarType = lookup(Var, Info), + Cases = hipe_icode:switch_val_cases(I), + FailLabel = hipe_icode:switch_val_fail_label(I), + case legal_switch_val_cases(Cases, VarType) of + [] -> + [{FailLabel, Info}]; + LegalCases -> + switch_val_update_info(LegalCases, Var, VarType, + FailLabel, VarType, Info, []) + end. + +legal_switch_val_cases(Cases, Type) -> + legal_switch_val_cases(Cases, Type, []). + +legal_switch_val_cases([{Val, _Label} = VL|Left], Type, Acc) -> + ConstType = t_from_term(hipe_icode:const_value(Val)), + case t_is_subtype(ConstType, Type) of + true -> + legal_switch_val_cases(Left, Type, [VL|Acc]); + false -> + legal_switch_val_cases(Left, Type, Acc) + end; +legal_switch_val_cases([], _Type, Acc) -> + lists:reverse(Acc). + +switch_val_update_info([{Const, Label}|Left], Arg, ArgType, + FailLabel, FailType, Info, Acc) -> + TrueType = t_from_term(hipe_icode:const_value(Const)), + NewInfo = enter(Arg, TrueType, Info), + NewFailType = t_subtract(FailType, TrueType), + switch_val_update_info(Left, Arg, ArgType, FailLabel, NewFailType, + Info, [{Label, NewInfo}|Acc]); +switch_val_update_info([], Arg, _ArgType, FailLabel, FailType,Info, Acc) -> + [{FailLabel, enter(Arg, FailType, Info)}|Acc]. + +test_cons_or_nil(Type, Var, VarInfo, TrueLab, FalseLab, Info) -> + case t_is_any(VarInfo) of + true -> + [{TrueLab, enter(Var, Type, Info)}, + {FalseLab, Info}]; + false -> + TrueType = t_inf(VarInfo, Type), + FalseType = t_subtract(VarInfo, TrueType), + case t_is_none(FalseType) of + true -> + [{TrueLab, Info}]; + false -> + case t_is_none(TrueType) of + true -> + [{FalseLab, Info}]; + false -> + [{TrueLab, enter(Var, TrueType, Info)}, + {FalseLab, enter(Var, FalseType, Info)}] + end + end + end. + +test_number_or_atom(Fun, X, Var, VarInfo, TypeTest, + TrueLab, FalseLab, Info) -> + case t_is_any(VarInfo) of + true -> + [{TrueLab, enter(Var, Fun(X), Info)}, + {FalseLab, Info}]; + false -> + case test_type(TypeTest, VarInfo) of + false -> + [{FalseLab, Info}]; + true -> + [{TrueLab, Info}]; + maybe -> + FalseType = t_subtract(VarInfo, Fun(X)), + [{TrueLab, enter(Var, Fun(X), Info)}, + {FalseLab, enter(Var, FalseType, Info)}] + end + end. + +test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info) -> + AnyList = lists:duplicate(Size - 1, t_any()), + RecordType = t_tuple([t_atom(Atom)|AnyList]), + Inf = t_inf(RecordType, VarInfo), + case t_is_none(Inf) of + true -> + [{FalseLab, Info}]; + false -> + Sub = t_subtract(VarInfo, Inf), + case t_is_none(Sub) of + true -> + [{TrueLab, enter(Var, Inf, Info)}]; + false -> + [{TrueLab, enter(Var, Inf, Info)}, + {FalseLab, enter(Var, Sub, Info)}] + end + end. + +test_type(Test, Type) -> + %%io:format("Test is: ~w\n", [Test]), + %%io:format("Type is: ~s\n", [format_type(Type)]), + Ans = + case t_is_any(Type) of + true -> maybe; + false -> + TrueTest = true_branch_info(Test), + Inf = t_inf(TrueTest, Type), + %%io:format("TrueTest is: ~s\n", [format_type(TrueTest)]), + %%io:format("Inf is: ~s\n", [format_type(Inf)]), + case t_is_equal(Type, Inf) of + true -> + not t_is_none(Type); + false -> + case t_is_equal(TrueTest, Inf) of + true -> + case test_type0(Test, Type) of + false -> + maybe; + true -> + true; + maybe -> + maybe + end; + false -> + case test_type0(Test, Inf) of + true -> + maybe; + false -> + false; + maybe -> + maybe + end + end + end + end, + %% io:format("Result is: ~s\n\n", [Ans]), + Ans. + +test_type0(integer, T) -> + t_is_integer(T); +test_type0({integer, N}, T) -> + case t_is_integer(T) of + true -> + case t_number_vals(T) of + unknown -> maybe; + [N] -> true; + List when is_list(List) -> + case lists:member(N, List) of + true -> maybe; + false -> false + end + end; + false -> false + end; +test_type0(float, T) -> + t_is_float(T); +test_type0(number, T) -> + t_is_number(T); +test_type0(atom, T) -> + t_is_atom(T); +test_type0({atom, A}, T) -> + case t_is_atom(T) of + true -> + case t_atom_vals(T) of + unknown -> maybe; + [A] -> true; + List when is_list(List) -> + case lists:member(A, List) of + true -> maybe; + false -> false + end + end; + false -> false + end; +test_type0(tuple, T) -> + t_is_tuple(T); +test_type0({tuple, N}, T) -> + case t_is_tuple(T) of + true -> + case t_tuple_sizes(T) of + unknown -> maybe; + [X] when is_integer(X) -> X =:= N; + List when is_list(List) -> + case lists:member(N, List) of + true -> maybe; + false -> false + end + end; + false -> false + end; +test_type0(pid, T) -> + t_is_pid(T); +test_type0(port, T) -> + t_is_port(T); +test_type0(binary, T) -> + t_is_binary(T); +test_type0(bitstr, T) -> + t_is_bitstr(T); +test_type0(reference, T) -> + t_is_reference(T); +test_type0(function, T) -> + t_is_fun(T); +test_type0(boolean, T) -> + t_is_boolean(T); +test_type0(list, T) -> + t_is_maybe_improper_list(T); +test_type0(cons, T) -> + t_is_cons(T); +test_type0(nil, T) -> + t_is_nil(T); +test_type0(constant, T) -> + t_is_constant(T). + + +true_branch_info(integer) -> + t_integer(); +true_branch_info({integer, N}) -> + t_integer(N); +true_branch_info(float) -> + t_float(); +true_branch_info(number) -> + t_number(); +true_branch_info(atom) -> + t_atom(); +true_branch_info({atom, A}) -> + t_atom(A); +true_branch_info(list) -> + t_maybe_improper_list(); +true_branch_info(tuple) -> + t_tuple(); +true_branch_info({tuple, N}) -> + t_tuple(N); +true_branch_info(pid) -> + t_pid(); +true_branch_info(port) -> + t_port(); +true_branch_info(binary) -> + t_binary(); +true_branch_info(bitstr) -> + t_bitstr(); +true_branch_info(reference) -> + t_reference(); +true_branch_info(function) -> + t_fun(); +true_branch_info(cons) -> + t_cons(); +true_branch_info(nil) -> + t_nil(); +true_branch_info(boolean) -> + t_boolean(); +true_branch_info(constant) -> + t_constant(); +true_branch_info(T) -> + exit({?MODULE,unknown_typetest,T}). + + +%% _________________________________________________________________ +%% +%% Remove the redundant type tests. If a test is removed, the trace +%% that isn't taken is explicitly removed from the CFG to simpilify +%% the handling of Phi nodes. If a Phi node is left and at least one +%% branch into it has disappeared, the SSA propagation pass can't +%% handle it. +%% +%% If the CFG has changed at the end of this pass, the analysis is +%% done again since we might be able to find more information because +%% of the simplification of the CFG. +%% + +simplify_controlflow(State) -> + Cfg = state__cfg(State), + simplify_controlflow(hipe_icode_cfg:reverse_postorder(Cfg), State). + +simplify_controlflow([Label|Left], State) -> + Info = state__info_out(State, Label), + NewState = + case state__bb(State, Label) of + not_found -> State; + BB -> + I = hipe_bb:last(BB), + case I of + #icode_if{} -> + rewrite_if(State,I,BB,Info,Label); + #icode_type{} -> + rewrite_type(State,I,BB,Info,Label); + #icode_switch_tuple_arity{} -> + rewrite_switch_tuple_arity(State,I,BB,Info,Label); + #icode_switch_val{} -> + rewrite_switch_val(State,I,BB,Info,Label); + #icode_call{} -> + rewrite_call(State,I,BB,Info,Label); + _ -> + State + end + end, + simplify_controlflow(Left, NewState); +simplify_controlflow([], State) -> + State. + +rewrite_if(State, I, BB, Info, Label) -> + case do_if(I, Info) of + [{Lab, _}] -> + mk_goto(State, BB, Label, Lab); + [_,_] -> + State + end. + +rewrite_type(State, I, BB, Info, Label) -> + FalseLab = hipe_icode:type_false_label(I), + case hipe_icode:type_true_label(I) of + FalseLab -> + %% true label = false label, this can occur! + mk_goto(State, BB, Label, FalseLab); + TrueLab -> + case do_type(I, Info) of + [{TrueLab, _}] -> + mk_goto(State, BB, Label, TrueLab); + [{FalseLab, _}] -> + mk_goto(State, BB, Label, FalseLab); + [_,_] -> %% Maybe + State + end + end. + +rewrite_switch_tuple_arity(State, I, BB, Info, Label) -> + Cases = hipe_icode:switch_tuple_arity_cases(I), + Var = hipe_icode:switch_tuple_arity_term(I), + Type = safe_lookup(Var, Info), + case legal_switch_tuple_arity_cases(Cases, Type) of + [] -> + Fail = hipe_icode:switch_tuple_arity_fail_label(I), + mk_goto(State, BB, Label, Fail); + Cases -> + %% Nothing changed. + case switch_tuple_arity_can_fail(Cases, Type) of + true -> State; + false -> + NewCases = butlast(Cases), + {_Arity, NewFail} = lists:last(Cases), + TmpI = + hipe_icode:switch_tuple_arity_fail_label_update(I, NewFail), + NewI = + hipe_icode:switch_tuple_arity_cases_update(TmpI, NewCases), + NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]), + state__bb_add(State, Label, NewBB) + end; + LegalCases -> + NewI = + case switch_tuple_arity_can_fail(LegalCases, Type) of + true -> + hipe_icode:switch_tuple_arity_cases_update(I, LegalCases); + false -> + NewCases = butlast(LegalCases), + {_Arity, NewFail} = lists:last(LegalCases), + TmpI = + hipe_icode:switch_tuple_arity_cases_update(I, NewCases), + hipe_icode:switch_tuple_arity_fail_label_update(TmpI, NewFail) + end, + NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]), + state__bb_add(State, Label, NewBB) + end. + +rewrite_switch_val(State, I, BB, Info, Label) -> + Cases = hipe_icode:switch_val_cases(I), + Var = hipe_icode:switch_val_term(I), + VarType = safe_lookup(Var, Info), + case legal_switch_val_cases(Cases, VarType) of + [] -> + Fail = hipe_icode:switch_val_fail_label(I), + mk_goto(State, BB, Label, Fail); + Cases -> + State; + %% TODO: Find out whether switch_val can fail + %% just as switch_tuple_arity + LegalCases -> + NewI = hipe_icode:switch_val_cases_update(I, LegalCases), + NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]), + state__bb_add(State, Label, NewBB) + end. + +rewrite_call(State,I,BB,Info,Label) -> + case call_always_fails(I, Info) of + false -> + Fun = hipe_icode:call_fun(I), + case hipe_icode_primops:fails(Fun) of + false -> + case hipe_icode:call_fail_label(I) of + [] -> State; + _ -> unset_fail(State, BB, Label, I) + end; + true -> State + end; + true -> + case hipe_icode:call_in_guard(I) of + false -> State; + true -> + FailLabel = hipe_icode:call_fail_label(I), + mk_goto(State, BB, Label, FailLabel) + end + end. + +mk_goto(State, BB, Label, Succ) -> + NewI = hipe_icode:mk_goto(Succ), + NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]), + state__bb_add(State, Label, NewBB). + +unset_fail(State, BB, Label, I) -> + %%io:format("Setting a guard that cannot fail\n", []), + NewI = hipe_icode:call_set_fail_label(I, []), + NewBB = hipe_bb:code_update(BB, hipe_bb:butlast(BB) ++ [NewI]), + state__bb_add(State, Label, NewBB). + +%% _________________________________________________________________ +%% +%% Make transformations (specialisations) based on the type knowledge. +%% +%% Annotate the variables with the local information. Since we have +%% the code in SSA form and the type information can only depend on +%% assignments or branches (type tests), we can use the information +%% out of the block to annotate all variables in it. +%% + +-spec specialize(cfg()) -> cfg(). + +specialize(Cfg) -> + Labels = hipe_icode_cfg:reverse_postorder(Cfg), + transform_bbs(Labels, Cfg). + +transform_bbs([Label|Left], Cfg) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(BB), + NewCode = make_transformations(Code), + NewBB = hipe_bb:code_update(BB, NewCode), + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB), + transform_bbs(Left, NewCfg); +transform_bbs([], Cfg) -> + Cfg. + +make_transformations(Is) -> + lists:flatten([transform_insn(I) || I <- Is]). + +transform_insn(I) -> + case I of + #icode_call{} -> + handle_call_and_enter(I); + #icode_enter{} -> + handle_call_and_enter(I); + #icode_if{} -> + CurrentIfOp = hipe_icode:if_op(I), + UsesFixnums = all_fixnums([get_type(A) || A <- hipe_icode:args(I)]), + AnyImmediate = any_immediate([get_type(A) || A <- hipe_icode:args(I)]), + ExactComp = is_exact_comp(CurrentIfOp), + if UsesFixnums -> + hipe_icode:if_op_update(I, fixnum_ifop(CurrentIfOp)); + AnyImmediate andalso ExactComp -> + hipe_icode:if_op_update(I, fixnum_ifop(CurrentIfOp)); + true -> + I + end; + _ -> + I + end. + +handle_call_and_enter(I) -> + case call_or_enter_fun(I) of + #element{} -> + transform_insn(update_call_or_enter(I, {erlang, element, 2})); + {erlang, element, 2} -> + NewI1 = transform_element2(I), + case is_record(I, icode_call) andalso hipe_icode:call_in_guard(I) of + true -> + case hipe_icode:call_fun(NewI1) of + #unsafe_element{} -> NewI1; + _ -> I + end; + false -> + NewI1 + end; + {erlang, hd, 1} -> transform_hd_or_tl(I, unsafe_hd); + {erlang, tl, 1} -> transform_hd_or_tl(I, unsafe_tl); + {hipe_bs_primop, BsOP} -> + NewBsOp = + bit_opts(BsOP, get_type_list(hipe_icode:args(I))), + update_call_or_enter(I, {hipe_bs_primop, NewBsOp}); + conv_to_float -> + [Src] = hipe_icode:args(I), + case t_is_float(get_type(Src)) of + true -> + update_call_or_enter(I, unsafe_untag_float); + false -> + I + end; + FunName -> + case is_arith_function(FunName) of + true -> + case strength_reduce(I, FunName) of + NewIs when is_list(NewIs) -> + [pos_transform_arith(NewI) || NewI <- NewIs]; + NewI -> + pos_transform_arith(NewI) + end; + false -> + I + end + end. + +pos_transform_arith(I) -> + case hipe_icode:is_enter(I) orelse hipe_icode:is_call(I) of + true -> + FunName = call_or_enter_fun(I), + transform_arith(I, FunName); + false -> + I + end. + +is_arith_function(Name) -> + case Name of + 'band' -> true; + 'bor' -> true; + 'bxor' -> true; + 'bnot' -> true; + 'bsl' -> true; + 'bsr' -> true; + '+' -> true; + '-' -> true; + '*' -> true; + 'div' -> true; + 'rem' -> true; + _ -> false + end. + +%%--------------------------------------------------------------------- +%% Perform a limited form of strength reduction for multiplication and +%% division of an integer with constants which are multiples of 2. +%%--------------------------------------------------------------------- + +strength_reduce(I, Op) -> + case Op of + '*' -> + [Arg1, Arg2] = mult_args_const_second(I), + ArgT1 = get_type(Arg1), + case t_is_integer(ArgT1) of + true -> + case hipe_icode:is_const(Arg2) of + true -> + case hipe_icode:const_value(Arg2) of + 0 -> case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [Dst] -> create_strength_reduce_move(I, Dst, Arg2) + end; + 1 -> case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [Dst] -> create_strength_reduce_move(I, Dst, Arg1) + end; + 2 -> strength_reduce_imult(I, Arg1, 1); + 4 -> strength_reduce_imult(I, Arg1, 2); + 8 -> strength_reduce_imult(I, Arg1, 3); + 16 -> strength_reduce_imult(I, Arg1, 4); + 32 -> strength_reduce_imult(I, Arg1, 5); + 64 -> strength_reduce_imult(I, Arg1, 6); + 128 -> strength_reduce_imult(I, Arg1, 7); + 256 -> strength_reduce_imult(I, Arg1, 8); + ___ -> I + end; + false -> I + end; + false -> I + end; + 'div' -> + [Arg1, Arg2] = hipe_icode:args(I), + ArgT1 = get_type(Arg1), + case t_is_non_neg_integer(ArgT1) of + true -> %% the optimization is NOT valid for negative integers + case hipe_icode:is_const(Arg2) of + true -> + case hipe_icode:const_value(Arg2) of + 0 -> io:fwrite("Integer division by 0 detected!\n"), I; + 1 -> case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [Dst] -> create_strength_reduce_move(I, Dst, Arg1) + end; + 2 -> strength_reduce_div(I, Arg1, 1); + 4 -> strength_reduce_div(I, Arg1, 2); + 8 -> strength_reduce_div(I, Arg1, 3); + 16 -> strength_reduce_div(I, Arg1, 4); + 32 -> strength_reduce_div(I, Arg1, 5); + 64 -> strength_reduce_div(I, Arg1, 6); + 128 -> strength_reduce_div(I, Arg1, 7); + 256 -> strength_reduce_div(I, Arg1, 8); + ___ -> I + end; + false -> I + end; + false -> I + end; + 'rem' -> + [Arg1, Arg2] = hipe_icode:args(I), + ArgT1 = get_type(Arg1), + case t_is_non_neg_integer(ArgT1) of + true -> %% the optimization is NOT valid for negative integers + case hipe_icode:is_const(Arg2) of + true -> + case hipe_icode:const_value(Arg2) of + 0 -> io:fwrite("Remainder with 0 detected!\n"), I; + 1 -> case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [Dst] -> create_strength_reduce_move( + I, Dst, hipe_icode:mk_const(0)) + end; + 2 -> strength_reduce_rem(I, Arg1, 1); + 4 -> strength_reduce_rem(I, Arg1, 3); + 8 -> strength_reduce_rem(I, Arg1, 7); + 16 -> strength_reduce_rem(I, Arg1, 15); + 32 -> strength_reduce_rem(I, Arg1, 31); + 64 -> strength_reduce_rem(I, Arg1, 63); + 128 -> strength_reduce_rem(I, Arg1, 127); + 256 -> strength_reduce_rem(I, Arg1, 255); + ___ -> I + end; + false -> I + end; + false -> I + end; + _ -> I + end. + +remove_useless_arithmetic_instruction(_) -> + []. + +create_strength_reduce_move(I, Dst, Val) -> + case hipe_icode:call_continuation(I) of + [] -> + hipe_icode:mk_move(Dst, Val); + Lbl -> + [hipe_icode:mk_move(Dst, Val), + hipe_icode:mk_goto(Lbl)] + end. + +%% Puts the args of a multiplication in a form where the constant +%% (if present) is always the second argument. +mult_args_const_second(I) -> + [Arg1, Arg2] = Args = hipe_icode:args(I), + case hipe_icode:is_const(Arg1) of + true -> [Arg2, Arg1]; + false -> Args + end. + +%% In all three functions below: +%% - Arg1 is a variable of integer type +%% - N is a small positive integer that will be used in a bit shift operation +strength_reduce_imult(I, Arg1, N) -> + case t_number_vals(get_type(Arg1)) of + [X] when is_integer(X) -> + %% io:format("Multiplication with constant arguments:\n ~w\n", [I]), + case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X bsl N)) + end; + _ -> + update_call_or_enter(I, 'bsl', [Arg1, hipe_icode:mk_const(N)]) + end. + +strength_reduce_div(I, Arg1, N) -> + case t_number_vals(get_type(Arg1)) of + [X] when is_integer(X) -> + %% io:format("Division with constant arguments:\n ~w\n", [I]), + case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X bsr N)) + end; + _ -> + update_call_or_enter(I, 'bsr', [Arg1, hipe_icode:mk_const(N)]) + end. + +strength_reduce_rem(I, Arg1, N) -> + case t_number_vals(get_type(Arg1)) of + [X] when is_integer(X) -> + %% io:format("Remainder with constant arguments:\n ~w\n", [I]), + case call_dstlist(I) of + [] -> remove_useless_arithmetic_instruction(I); + [D] -> create_strength_reduce_move(I, D, hipe_icode:mk_const(X band N)) + end; + _ -> + update_call_or_enter(I, 'band', [Arg1, hipe_icode:mk_const(N)]) + end. + +%%--------------------------------------------------------------------- + +call_or_enter_fun(I) -> + case hipe_icode:is_call(I) of + true -> hipe_icode:call_fun(I); + false -> hipe_icode:enter_fun(I) + end. + +update_call_or_enter(I, NewFun) -> + case hipe_icode:is_call(I) of + true -> + case hipe_icode_primops:fails(NewFun) of + false -> + NewI = hipe_icode:call_fun_update(I, NewFun), + hipe_icode:call_set_fail_label(NewI, []); + true -> + hipe_icode:call_fun_update(I, NewFun) + end; + false -> hipe_icode:enter_fun_update(I, NewFun) + end. + +update_call_or_enter(I, NewFun, NewArgs) -> + case hipe_icode:is_call(I) of + true -> + I1 = hipe_icode:call_args_update(I, NewArgs), + hipe_icode:call_fun_update(I1, NewFun); + false -> + I1 = hipe_icode:enter_args_update(I, NewArgs), + hipe_icode:enter_fun_update(I1, NewFun) + end. + +transform_element2(I) -> + [Index, Tuple] = hipe_icode:args(I), + IndexType = get_type(Index), + TupleType = get_type(Tuple), + ?debug("Tuple", TupleType), + NewIndex = + case test_type(integer, IndexType) of + true -> + case t_number_vals(IndexType) of + unknown -> unknown; + [_|_] = Vals -> {number, Vals} + end; + _ -> unknown + end, + MinSize = + case test_type(tuple, TupleType) of + true -> + ?debug("is tuple", TupleType), + case t_tuple_sizes(TupleType) of + unknown -> unknown; + Sizes -> {tuple, lists:min(Sizes)} + end; + _ -> unknown + end, + case {NewIndex, MinSize} of + {{number, [_|_] = Ns}, {tuple, A}} when is_integer(A) -> + case lists:all(fun(X) -> 0 < X andalso X =< A end, Ns) of + true -> + case Ns of + [Idx] -> + [_, Tuple] = hipe_icode:args(I), + update_call_or_enter(I, #unsafe_element{index = Idx}, [Tuple]); + [_|_] -> + NewFun = {element, [MinSize, valid]}, + update_call_or_enter(I, NewFun) + end; + false -> + case lists:all(fun(X) -> hipe_tagscheme:is_fixnum(X) end, Ns) of + true -> + NewFun = {element, [MinSize, fixnums]}, + update_call_or_enter(I, NewFun); + false -> + NewFun = {element, [MinSize, unknown]}, + update_call_or_enter(I, NewFun) + end + end; + _ when (NewIndex =:= unknown) orelse (MinSize =:= unknown) -> + case t_is_fixnum(IndexType) of + true -> + NewFun = {element, [MinSize, fixnums]}, + update_call_or_enter(I, NewFun); + false -> + NewFun = {element, [MinSize, NewIndex]}, + update_call_or_enter(I, NewFun) + end + end. + +transform_hd_or_tl(I, Primop) -> + [Arg] = hipe_icode:args(I), + case t_is_cons(get_type(Arg)) of + true -> update_call_or_enter(I, Primop); + false -> I + end. + +transform_arith(I, Op) -> + ArgTypes = get_type_list(hipe_icode:args(I)), + %% io:format("Op = ~w, Args = ~w\n", [Op, ArgTypes]), + DstTypes = + case hipe_icode:is_call(I) of + true -> get_type_list(call_dstlist(I)); + false -> [erl_bif_types:type(erlang, Op, length(ArgTypes), ArgTypes)] + end, + case valid_unsafe_args(ArgTypes, Op) of + true -> + case all_is_fixnum(DstTypes) of + true -> + update_call_or_enter(I, arithop_to_extra_unsafe(Op)); + false -> + update_call_or_enter(I, arithop_to_unsafe(Op)) + end; + false -> + I + end. + +all_is_fixnum(Types) -> + lists:all(fun erl_types:t_is_fixnum/1, Types). + +valid_unsafe_args(Args, Op) -> + if Op =:= 'bnot' -> + [Arg] = Args, + t_is_fixnum(Arg); + true -> + [LeftArg, RightArg] = Args, + case Op of + 'bsl' -> t_is_fixnum(LeftArg) and t_is_bitwidth(RightArg); + 'bsr' -> t_is_fixnum(LeftArg) and t_is_bitwidth(RightArg); + _ -> t_is_fixnum(LeftArg) and t_is_fixnum(RightArg) + end + end. + +arithop_to_extra_unsafe(Op) -> + case Op of + '+' -> extra_unsafe_add; + '-' -> extra_unsafe_sub; + '*' -> '*'; %% XXX: Revise? + 'div' -> 'div'; %% XXX: Revise? + 'rem' -> 'rem'; %% XXX: Revise? + 'band' -> unsafe_band; + 'bor' -> unsafe_bor; + 'bxor' -> unsafe_bxor; + 'bnot' -> unsafe_bnot; + 'bsl' -> unsafe_bsl; + 'bsr' -> unsafe_bsr + end. + +arithop_to_unsafe(Op) -> + case Op of + '+' -> unsafe_add; + '-' -> unsafe_sub; + _ -> Op + end. + +fixnum_ifop(Op) -> + case Op of + '=:=' -> 'fixnum_eq'; + '=/=' -> 'fixnum_neq'; + '==' -> 'fixnum_eq'; + '/=' -> 'fixnum_neq'; + '>' -> 'fixnum_gt'; + '<' -> 'fixnum_lt'; + '>=' -> 'fixnum_ge'; + '=<' -> 'fixnum_le'; + Op -> Op + end. + +bit_opts({Name, Size, Flags} = I, [MSType]) when Name =:= bs_get_integer; + Name =:= bs_get_float; + Name =:= bs_get_binary -> + Bits = t_matchstate_present(MSType), + case t_is_bitstr(Bits) of + true -> + Base = t_bitstr_base(Bits), + if Base >= Size -> + {Name, Size, Flags bor 16}; + true -> I + end; + false -> I + end; +bit_opts({bs_get_binary_all, Size, Flags} = I, [MSType]) -> + Bits = t_matchstate_present(MSType), + case t_is_bitstr(Bits) of + true -> + Base = t_bitstr_base(Bits), + Unit = t_bitstr_unit(Bits), + if (Base rem Size) =:= 0 andalso (Unit rem Size) =:= 0 -> + {bs_get_binary_all, Size, Flags bor 16}; + true -> I + end; + false -> I + end; +bit_opts({bs_test_unit, Size} = I, [MSType]) -> + Bits = t_matchstate_present(MSType), + case t_is_bitstr(Bits) of + true -> + Base = t_bitstr_base(Bits), + Unit = t_bitstr_unit(Bits), + if (Base rem Size) =:= 0 andalso (Unit rem Size) =:= 0 -> + {bs_test_unit, 1}; + true -> I + end; + false -> I + end; +bit_opts({bs_put_integer, Size, Flags, ConstInfo} = I, [Src|_]) -> + case t_is_fixnum(Src) of + true -> + {unsafe_bs_put_integer, Size, Flags, ConstInfo}; + false -> I + end; +bit_opts({bs_start_match, Max} = I, [Src]) -> + case t_is_bitstr(Src) of + true -> {{bs_start_match, bitstr}, Max}; + false -> + MSorNone = t_inf(t_matchstate(), Src), + case t_is_matchstate(MSorNone) of + true -> + Slots = t_matchstate_slots(MSorNone), + case t_is_any(Slots) orelse (length(t_to_tlist(Slots)) =< Max) of + true -> I; + false -> {{bs_start_match, ok_matchstate}, Max} + end; + false -> I + end + end; +bit_opts(I, _) -> I. + +is_exact_comp(Op) -> + case Op of + '=:=' -> true; + '=/=' -> true; + _Op -> false + end. + +all_fixnums([Type|Types]) -> + t_is_fixnum(Type) andalso all_fixnums(Types); +all_fixnums([]) -> + true. + +any_immediate([Type|Types]) -> + t_is_fixnum(Type) orelse t_is_atom(Type) orelse any_immediate(Types); +any_immediate([]) -> false. + +get_standard_primop(unsafe_bsl) -> 'bsl'; +get_standard_primop(unsafe_bsr) -> 'bsr'; +get_standard_primop(unsafe_add) -> '+'; +get_standard_primop(extra_unsafe_add) -> '+'; +get_standard_primop(unsafe_bnot) -> 'bnot'; +get_standard_primop(unsafe_bxor) -> 'bxor'; +get_standard_primop(unsafe_band) -> 'band'; +get_standard_primop(unsafe_bor) -> 'bor'; +get_standard_primop(unsafe_sub) -> '-'; +get_standard_primop(extra_unsafe_sub) -> '-'; +get_standard_primop(Op) -> Op. + +primop_type(Op, Args) -> + case Op of + #mkfun{mfa = MFA} -> + t_inf(t_fun(), find_signature_mfa(MFA)); + _ -> + None = t_none(), + Primop = get_standard_primop(Op), + RetType = hipe_icode_primops:type(Primop, Args), + case RetType of + None -> + hipe_icode_primops:type(Primop, add_funs_to_arg_types(Args)); + Other -> + Other + end + end. + +%%------------------------------------------------------------------ +%% Various help functions. +%%------------------------------------------------------------------ + +add_arg_types(Args, Types) -> + add_arg_types(Args, Types, gb_trees:empty()). + +add_arg_types([Arg|Args], [Type|Types], Acc) -> + Type1 = + case t_is_none(Type) of + true -> t_any(); + false -> Type + end, + add_arg_types(Args,Types, enter(Arg, Type1, Acc)); +add_arg_types(_, [], Acc) -> + Acc. + +get_type_list(ArgList) -> + [get_type(Arg) || Arg <- ArgList]. + +get_type(Arg) -> + case hipe_icode:is_annotated_variable(Arg) of + true -> + None = t_none(), + case hipe_icode:variable_annotation(Arg) of + {type_anno, None, _} -> t_any(); + {type_anno, Type, _} -> Type + end; + false -> + case hipe_icode:is_const(Arg) of + true -> const_type(Arg); + false -> t_any() + end + end. + +%% Lookup treats anything that is neither in the map or a constant as +%% t_none(). Use this during type propagation! + +lookup(Var, Tree) -> + case gb_trees:lookup(Var, Tree) of + none -> + case hipe_icode:is_const(Var) of + true -> const_type(Var); + false -> t_none() + end; + {value, Type} -> + Type + end. + +lookup_list(List, Info) -> + lookup_list0(List, Info, []). + +lookup_list0([H|T], Info, Acc) -> + lookup_list0(T, Info, [lookup(H, Info)|Acc]); +lookup_list0([], _, Acc) -> + lists:reverse(Acc). + + +%% safe_lookup treats anything that is neither in the map nor a +%% constant as t_any(). Use this during transformations. + +safe_lookup(Var, Tree) -> + case gb_trees:lookup(Var, Tree) of + none -> + case hipe_icode:is_const(Var) of + true -> const_type(Var); + false -> + %% io:format("Expression has undefined type\n",[]), + t_any() + end; + {value, Type} -> + Type + end. + +safe_lookup_list(List, Info) -> + safe_lookup_list0(List, Info, []). + +safe_lookup_list0([H|T], Info, Acc) -> + safe_lookup_list0(T, Info, [safe_lookup(H, Info)|Acc]); +safe_lookup_list0([], _, Acc) -> + lists:reverse(Acc). + +enter_list([Var|VarLeft], [Type|TypeLeft], Info) -> + NewInfo = enter(Var, Type, Info), + enter_list(VarLeft, TypeLeft, NewInfo); +enter_list([], [], Info) -> + Info. + +enter([Key], Value, Tree) -> + enter(Key, Value, Tree); +enter(Key, Value, Tree) -> + case is_var_or_reg(Key) of + true -> + case t_is_none(Value) of + true -> + gb_trees:delete_any(Key, Tree); + false -> + gb_trees:enter(Key, Value, Tree) + end; + false -> + Tree + end. + +join_list(List, Info) -> + join_list(List, Info, t_none()). + +join_list([H|T], Info, Acc) -> + Type = t_sup(lookup(H, Info), Acc), + join_list(T, Info, Type); +join_list([], _, Acc) -> + Acc. + +join_info_in([], _OldInfo, _NewInfo) -> + %% No variables are live in. The information must be at a fixpoint. + fixpoint; +join_info_in(Vars, OldInfo, NewInfo) -> + NewInfo2 = join_info_in(Vars, Vars, OldInfo, NewInfo, gb_trees:empty()), + case info_is_equal(NewInfo2, OldInfo) of + true -> fixpoint; + false -> NewInfo2 + end. + +%% NOTE: Variables can be bound to other variables. Joining these is +%% only possible if the binding is the same from both traces and this +%% variable is still live. + +join_info_in([Var|Left], LiveIn, Info1, Info2, Acc) -> + Type1 = gb_trees:lookup(Var, Info1), + Type2 = gb_trees:lookup(Var, Info2), + case {Type1, Type2} of + {none, none} -> + join_info_in(Left, LiveIn, Info1, Info2, Acc); + {none, {value, Val}} -> + NewTree = gb_trees:insert(Var, Val, Acc), + join_info_in(Left, LiveIn, Info1, Info2, NewTree); + {{value, Val}, none} -> + NewTree = gb_trees:insert(Var, Val, Acc), + join_info_in(Left, LiveIn, Info1, Info2, NewTree); + {{value, Val1}, {value, Val2}} -> + NewTree = gb_trees:insert(Var, t_sup(Val1, Val2), Acc), + join_info_in(Left, LiveIn, Info1, Info2, NewTree) + end; +join_info_in([], _LiveIn, _Info1, _Info2, Acc) -> + Acc. + +info_is_equal(Info1, Info2) -> + compare(gb_trees:to_list(Info1), gb_trees:to_list(Info2)). + +compare([{Var, Type1}|Left1], [{Var, Type2}|Left2]) -> + t_is_equal(Type1, Type2) andalso compare(Left1, Left2); +compare([], []) -> + true; +compare(_, _) -> + false. + +const_type(Const) -> + t_from_term(hipe_icode:const_value(Const)). + +do_updates(State, List) -> + do_updates(State, List, []). + +do_updates(State, [{Label, Info}|Tail], Worklist) -> + case state__info_in_update(State, Label, Info) of + fixpoint -> + %% io:format("Info in for ~w is: fixpoint\n", [Label]), + do_updates(State, Tail, Worklist); + NewState -> + %% io:format("Info in for ~w is:\n", [Label]), + %% [io:format("~w: ~p\n", [X, format_type(Y)]) + %% || {X, Y} <- gb_trees:to_list(state__info_in(NewState, Label))], + do_updates(NewState, Tail, [Label|Worklist]) + end; +do_updates(State, [], Worklist) -> + {State, Worklist}. + +enter_defines(I, Type, Info) -> + case defines(I) of + [] -> Info; + [Def] -> + enter(Def, Type, Info); + Defs -> + Pairs = case t_is_any(Type) of + true -> + [{Def, t_any()} || Def <- Defs]; + false -> + case t_is_none(Type) of + true -> + [{Def, t_none()} || Def <- Defs]; + false -> + lists:zip(Defs, t_to_tlist(Type)) + end + end, + lists:foldl(fun({X, T}, Inf) -> enter(X, T, Inf) end, Info, Pairs) + end. + +defines(I) -> + keep_vars_and_regs(hipe_icode:defines(I)). + +call_dstlist(I) -> + hipe_icode:call_dstlist(I). + +uses(I) -> + keep_vars_and_regs(hipe_icode:uses(I)). + +keep_vars_and_regs(Vars) -> + [V || V <- Vars, is_var_or_reg(V)]. + +butlast([_]) -> + []; +butlast([H|T]) -> + [H|butlast(T)]. + +-spec any_is_none([erl_types:erl_type()]) -> boolean(). + +any_is_none(Types) -> + lists:any(fun (T) -> t_is_none(T) end, Types). + +is_var_or_reg(X) -> + hipe_icode:is_var(X) orelse hipe_icode:is_reg(X). + +%% _________________________________________________________________ +%% +%% Handling the state +%% + +new_state(Cfg, {MFA, GetCallFun, GetResFun, FinalAction}) -> + Start = hipe_icode_cfg:start_label(Cfg), + Params = hipe_icode_cfg:params(Cfg), + ParamTypes = GetCallFun(MFA, Cfg), + case any_is_none(ParamTypes) of + true -> + FinalAction(MFA, [t_none()]), + throw(no_input); + false -> + Info = add_arg_types(Params, ParamTypes), + InfoMap = gb_trees:insert({Start, in}, Info, gb_trees:empty()), + Liveness = hipe_icode_ssa:ssa_liveness__analyze(Cfg), + #state{info_map = InfoMap, cfg = Cfg, liveness = Liveness, + arg_types = ParamTypes, lookupfun = GetResFun, + resultaction = FinalAction} + end. + +state__cfg(#state{cfg = Cfg}) -> + Cfg. + +state__succ(#state{cfg = Cfg}, Label) -> + hipe_icode_cfg:succ(Cfg, Label). + +state__bb(#state{cfg = Cfg}, Label) -> + hipe_icode_cfg:bb(Cfg, Label). + +state__bb_add(S = #state{cfg = Cfg}, Label, BB) -> + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), + S#state{cfg=NewCfg}. + +state__params_update(S = #state{cfg = Cfg}, NewParams) -> + NewCfg = hipe_icode_cfg:params_update(Cfg, NewParams), + S#state{cfg = NewCfg}. + +state__ret_type(#state{ret_type = RT}) -> RT. + +state__lookupfun(#state{lookupfun = LF}) -> LF. + +state__resultaction(#state{resultaction = RA}) -> RA. + +state__info_in(S, Label) -> + state__info(S, {Label, in}). + +state__info_out(S, Label) -> + state__info(S, {Label, out}). + +state__info(#state{info_map = IM}, Label) -> + case gb_trees:lookup(Label, IM) of + {value, Info} -> Info; + none -> gb_trees:empty() + end. + +state__ret_type_update(#state{ret_type = RT} = State, NewType) when + is_list(NewType) -> + TotType = lists:zipwith(fun erl_types:t_sup/2, RT, NewType), + State#state{ret_type = TotType}; +state__ret_type_update(#state{ret_type = RT} = State, NewType) -> + state__ret_type_update(State, [NewType || _ <- RT]). + +state__info_in_update(S=#state{info_map=IM, liveness=Liveness}, Label, Info) -> + LiveIn = hipe_icode_ssa:ssa_liveness__livein(Liveness, Label), + LabelIn = {Label, in}, + case gb_trees:lookup(LabelIn, IM) of + none -> + OldInfo = gb_trees:empty(), + case join_info_in(LiveIn, OldInfo, Info) of + fixpoint -> + %% If the BB has not been handled we ignore the fixpoint. + S#state{info_map = gb_trees:enter(LabelIn, OldInfo, IM)}; + NewInfo -> + S#state{info_map = gb_trees:enter(LabelIn, NewInfo, IM)} + end; + {value, OldInfo} -> + case join_info_in(LiveIn, OldInfo, Info) of + fixpoint -> + fixpoint; + NewInfo -> + S#state{info_map = gb_trees:enter(LabelIn, NewInfo, IM)} + end + end. + +state__info_out_update(#state{info_map = IM} = State, Label, Info) -> + State#state{info_map = gb_trees:enter({Label, out}, Info, IM)}. + +%% _________________________________________________________________ +%% +%% The worklist. +%% + +init_work(State) -> + %% Labels = hipe_icode_cfg:reverse_postorder(state__cfg(State)), + Labels = [hipe_icode_cfg:start_label(state__cfg(State))], + {Labels, [], gb_sets:from_list(Labels)}. + +get_work({[Label|Left], List, Set}) -> + NewWork = {Left, List, gb_sets:delete(Label, Set)}, + {Label, NewWork}; +get_work({[], [], _Set}) -> + fixpoint; +get_work({[], List, Set}) -> + get_work({lists:reverse(List), [], Set}). + +add_work(Work = {List1, List2, Set}, [Label|Left]) -> + case gb_sets:is_member(Label, Set) of + true -> + add_work(Work, Left); + false -> + %% io:format("Adding work: ~w\n", [Label]), + add_work({List1, [Label|List2], gb_sets:insert(Label, Set)}, Left) + end; +add_work(Work, []) -> + Work. + +%% _________________________________________________________________ +%% +%% Annotator +%% + +annotate_cfg(State) -> + Cfg = state__cfg(State), + NewState = annotate_params(hipe_icode_cfg:params(Cfg), State, + hipe_icode_cfg:start_label(Cfg)), + Labels = hipe_icode_cfg:reverse_postorder(Cfg), + annotate_bbs(Labels, NewState). + +annotate_params(Params, State, Start) -> + Info = state__info_in(State, Start), + AnnoFun = fun hipe_icode:annotate_variable/2, + NewParams = + lists:zipwith(AnnoFun, Params, [make_annotation(P,Info) || P <- Params]), + state__params_update(State,NewParams). + +annotate_bbs([Label|Left], State) -> + BB = state__bb(State, Label), + Code = hipe_bb:code(BB), + Info = state__info_in(State, Label), + NewCode = annotate_instr_list(Code, Info, state__lookupfun(State), []), + NewBB = hipe_bb:code_update(BB, NewCode), + NewState = state__bb_add(State, Label, NewBB), + annotate_bbs(Left, NewState); +annotate_bbs([], State) -> + State. + +annotate_instr_list([I], Info, LookupFun, Acc) -> + NewInfo = + case I of + #icode_call{} -> + do_safe_call(I, Info, LookupFun); + _ -> + analyse_insn(I, Info, LookupFun) + end, + NewI = annotate_instr(I, NewInfo, Info), + lists:reverse([NewI|Acc]); +annotate_instr_list([I|Left], Info, LookupFun, Acc) -> + NewInfo = + case I of + #icode_call{} -> + do_safe_call(I, Info, LookupFun); + _ -> + analyse_insn(I, Info, LookupFun) + end, + NewI = annotate_instr(I, NewInfo, Info), + annotate_instr_list(Left, NewInfo, LookupFun, [NewI|Acc]). + +annotate_instr(I, DefInfo, UseInfo) -> + Def = defines(I), + Use = uses(I), + Fun = fun hipe_icode:annotate_variable/2, + DefSubst = [{X, Fun(X, make_annotation(X, DefInfo))} || X <- Def], + UseSubst = [{X, Fun(X, make_annotation(X, UseInfo))} || X <- Use], + case DefSubst ++ UseSubst of + [] -> + I; + Subst -> + hipe_icode:subst(Subst, I) + end. + +make_annotation(X, Info) -> + {type_anno, safe_lookup(X, Info), fun erl_types:t_to_string/1}. + +-spec unannotate_cfg(cfg()) -> cfg(). + +unannotate_cfg(Cfg) -> + NewCfg = unannotate_params(Cfg), + Labels = hipe_icode_cfg:labels(NewCfg), + unannotate_bbs(Labels, NewCfg). + +unannotate_params(Cfg) -> + Params = hipe_icode_cfg:params(Cfg), + NewParams = [hipe_icode:unannotate_variable(X) + || X <- Params, hipe_icode:is_variable(X)], + hipe_icode_cfg:params_update(Cfg, NewParams). + +unannotate_bbs([Label|Left], Cfg) -> + BB = hipe_icode_cfg:bb(Cfg, Label), + Code = hipe_bb:code(BB), + NewCode = unannotate_instr_list(Code, []), + NewBB = hipe_bb:code_update(BB, NewCode), + NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB), + unannotate_bbs(Left, NewCfg); +unannotate_bbs([], Cfg) -> + Cfg. + +unannotate_instr_list([I|Left], Acc) -> + NewI = unannotate_instr(I), + unannotate_instr_list(Left, [NewI|Acc]); +unannotate_instr_list([], Acc) -> + lists:reverse(Acc). + +unannotate_instr(I) -> + DefUses = hipe_icode:defines(I) ++ hipe_icode:uses(I), + Subst = [{X, hipe_icode:unannotate_variable(X)} || X <- DefUses, + hipe_icode:is_variable(X)], + if Subst =:= [] -> I; + true -> hipe_icode:subst(Subst, I) + end. + +%% _________________________________________________________________ +%% +%% Find the types of the arguments to a call +%% + +update_call_arguments(I, Info) -> + Args = hipe_icode:call_args(I), + ArgTypes = lookup_list(Args, Info), + Signature = find_signature(hipe_icode:call_fun(I), length(Args)), + case t_fun_args(Signature) of + unknown -> + Info; + PltArgTypes -> + NewArgTypes = t_inf_lists(ArgTypes, PltArgTypes), + enter_list(Args, NewArgTypes, Info) + end. + +%% _________________________________________________________________ +%% +%% PLT info +%% + +find_signature(MFA = {_, _, _}, _) -> find_signature_mfa(MFA); +find_signature(Primop, Arity) -> find_signature_primop(Primop, Arity). + +find_signature_mfa(MFA) -> + case get_mfa_arg_types(MFA) of + any -> + t_fun(get_mfa_type(MFA)); + BifArgs -> + t_fun(BifArgs, get_mfa_type(MFA)) + end. + +find_signature_primop(Primop, Arity) -> + case get_primop_arg_types(Primop) of + any -> + t_fun(Arity, get_primop_type(Primop)); + ArgTypes -> + t_fun(ArgTypes, get_primop_type(Primop)) + end. + +get_primop_arg_types(Primop) -> + case hipe_icode_primops:arg_types(Primop) of + unknown -> any; + ArgTypes -> add_tuple_to_args(ArgTypes) + end. + +get_mfa_arg_types({M, F, A}) -> + case erl_bif_types:arg_types(M, F, A) of + unknown -> + any; + BifArgs -> + add_tuple_to_args(BifArgs) + end. + +get_mfa_type({M, F, A}) -> + erl_bif_types:type(M, F, A). + +get_primop_type(Primop) -> + hipe_icode_primops:type(get_standard_primop(Primop)). + +add_tuple_to_args(Types) -> + [add_tuple_to_type(T) || T <- Types]. + +add_tuple_to_type(T) -> + None = t_none(), + case t_inf(t_fun(), T) of + None -> T; + _Other -> t_sup(T, t_tuple([t_atom(),t_atom()])) + end. + +add_funs_to_arg_types(Types) -> + [add_fun_to_arg_type(T) || T <- Types]. + +add_fun_to_arg_type(T) -> + None = t_none(), + case t_inf(t_tuple([t_atom(),t_atom()]), T) of + None -> T; + _Other -> t_sup(T, t_fun()) + end. + +%%===================================================================== +%% Icode Coordinator Callbacks +%%===================================================================== + +-spec replace_nones([erl_types:erl_type()] | erl_types:erl_type()) -> + [erl_types:erl_type()]. + +replace_nones(Types) when is_list(Types) -> + [replace_none(T) || T <- Types]; +replace_nones(Type) -> + [replace_none(Type)]. + +-spec replace_none(erl_types:erl_type()) -> erl_types:erl_type(). + +replace_none(Type) -> + case erl_types:t_is_none(Type) of + true -> + erl_types:t_any(); + false -> + Type + end. + +-spec update__info([erl_types:erl_type()], [erl_types:erl_type()]) -> + {boolean(), [erl_types:erl_type()]}. + +update__info(NewTypes, OldTypes) -> + SupFun = + fun(T1, T2) -> erl_types:t_limit(erl_types:t_sup(T1,T2), ?TYPE_DEPTH) end, + EqFun = fun erl_types:t_is_equal/2, + ResTypes = lists:zipwith(SupFun, NewTypes, OldTypes), + Change = lists:zipwith(EqFun, ResTypes, OldTypes), + {lists:all(fun(X) -> X end, Change), ResTypes}. + +-spec new__info([erl_types:erl_type()]) -> [erl_types:erl_type()]. + +new__info(NewTypes) -> + [erl_types:t_limit(T, ?TYPE_DEPTH) || T <- NewTypes]. + +-spec return__info(erl_types:erl_type()) -> erl_types:erl_type(). + +return__info(Types) -> + Types. + +-spec return_none() -> [erl_types:erl_type(),...]. + +return_none() -> + [erl_types:t_none()]. + +-spec return_none_args(cfg(), mfa()) -> [erl_types:erl_type()]. + +return_none_args(Cfg, {_M,_F,A}) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg) - 1; + false -> A + end, + lists:duplicate(NoArgs, erl_types:t_none()). + +-spec return_any_args(cfg(), mfa()) -> [erl_types:erl_type()]. + +return_any_args(Cfg, {_M,_F,A}) -> + NoArgs = + case hipe_icode_cfg:is_closure(Cfg) of + true -> hipe_icode_cfg:closure_arity(Cfg); + false -> A + end, + lists:duplicate(NoArgs, erl_types:t_any()). + +%%===================================================================== +%% Testing function below +%%===================================================================== + +-ifdef(DO_HIPE_ICODE_TYPE_TEST). + +test() -> + Range1 = t_from_range(1, pos_inf), + Range2 = t_from_range(0, 5), + Var1 = hipe_icode:mk_var(1), + Var2 = hipe_icode:mk_var(2), + + Info = enter(Var1, Range1, enter(Var2, Range2, gb_trees:empty())), + io:format("A1 ~p~n", [Info]), + A = integer_range_inequality_propagation('<', Var1, Var2, 1, 2, Info), + B = integer_range_inequality_propagation('>=', Var1, Var2, 1, 2, Info), + C = integer_range_inequality_propagation('=<', Var1, Var2, 1, 2, Info), + D = integer_range_inequality_propagation('>', Var1, Var2, 1, 2, Info), + + io:format("< ~p~n", [A]), + io:format(">= ~p~n", [B]), + io:format("<= ~p~n", [C]), + io:format("> ~p~n", [D]). + +-endif. diff --git a/lib/hipe/icode/hipe_icode_type.hrl b/lib/hipe/icode/hipe_icode_type.hrl new file mode 100644 index 0000000000..dd69c1e8b2 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_type.hrl @@ -0,0 +1,25 @@ +%%% +%%% %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_icode_type.hrl +%%% Author : Tobias Lindahl +%%% Created : 2 Sep 2004 by Tobias Lindahl +%%%------------------------------------------------------------------- + +-define(TYPE_DEPTH, 3). -- cgit v1.2.3