aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe')
-rw-r--r--lib/hipe/cerl/Makefile4
-rw-r--r--lib/hipe/cerl/cerl_messagean.erl1095
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl40
-rw-r--r--lib/hipe/cerl/erl_types.erl239
-rw-r--r--lib/hipe/doc/src/Makefile1
-rw-r--r--lib/hipe/doc/src/hipe_app.xml84
-rw-r--r--lib/hipe/doc/src/notes.xml47
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl55
-rw-r--r--lib/hipe/icode/hipe_icode.erl30
-rw-r--r--lib/hipe/icode/hipe_icode.hrl8
-rw-r--r--lib/hipe/icode/hipe_icode_inline_bifs.erl22
-rw-r--r--lib/hipe/icode/hipe_icode_liveness.erl1
-rw-r--r--lib/hipe/icode/hipe_icode_pp.erl5
-rw-r--r--lib/hipe/icode/hipe_icode_primops.erl23
-rw-r--r--lib/hipe/icode/hipe_icode_range.erl6
-rw-r--r--lib/hipe/llvm/hipe_llvm.erl11
-rw-r--r--lib/hipe/llvm/hipe_llvm_main.erl2
-rw-r--r--lib/hipe/llvm/hipe_rtl_to_llvm.erl4
-rw-r--r--lib/hipe/main/hipe.app.src4
-rw-r--r--lib/hipe/main/hipe.erl30
-rw-r--r--lib/hipe/main/hipe_main.erl5
-rw-r--r--lib/hipe/opt/hipe_schedule.erl1483
-rw-r--r--lib/hipe/opt/hipe_schedule_prio.erl53
-rw-r--r--lib/hipe/opt/hipe_target_machine.erl87
-rw-r--r--lib/hipe/opt/hipe_ultra_mod2.erl233
-rw-r--r--lib/hipe/opt/hipe_ultra_prio.erl298
-rw-r--r--lib/hipe/rtl/Makefile2
-rw-r--r--lib/hipe/rtl/hipe_rtl.erl5
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_construct.erl22
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl10
-rw-r--r--lib/hipe/rtl/hipe_rtl_cleanup_const.erl4
-rw-r--r--lib/hipe/rtl/hipe_rtl_lcm.erl110
-rw-r--r--lib/hipe/rtl/hipe_rtl_primops.erl29
-rw-r--r--lib/hipe/rtl/hipe_rtl_varmap.erl2
-rw-r--r--lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl89
-rw-r--r--lib/hipe/rtl/hipe_tagscheme.erl141
-rw-r--r--lib/hipe/ssa/hipe_ssa.inc28
-rw-r--r--lib/hipe/test/Makefile3
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl215
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl28
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_receive.erl89
-rw-r--r--lib/hipe/test/erl_types_SUITE.erl197
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl16
-rw-r--r--lib/hipe/test/opt_verify_SUITE.erl6
-rw-r--r--lib/hipe/vsn.mk2
-rw-r--r--lib/hipe/x86/hipe_rtl_to_x86.erl24
-rw-r--r--lib/hipe/x86/hipe_x86_assemble.erl1
47 files changed, 1205 insertions, 3688 deletions
diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile
index 9f50d6bf91..f653dce36f 100644
--- a/lib/hipe/cerl/Makefile
+++ b/lib/hipe/cerl/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2016. All Rights Reserved.
+# Copyright Ericsson AB 2003-2018. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -44,7 +44,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
# Target Specs
# ----------------------------------------------------
MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_lib \
- cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \
+ cerl_pmatch cerl_prettypr cerl_to_icode \
cerl_typean erl_bif_types erl_types
HRL_FILES= cerl_hipe_primops.hrl
diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl
deleted file mode 100644
index c79e045bd0..0000000000
--- a/lib/hipe/cerl/cerl_messagean.erl
+++ /dev/null
@@ -1,1095 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% @copyright 2002 Richard Carlsson
-%% @author Richard Carlsson <[email protected]>
-%% @doc Message analysis of Core Erlang programs.
-
-%% TODO: might need a "top" (`any') element for any-length value lists.
-
--module(cerl_messagean).
-
--export([annotate/1]).
-
--import(cerl, [alias_pat/1, alias_var/1, ann_c_var/2, ann_c_fun/3,
- apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
- bitstr_val/1, binary_segments/1, c_letrec/2,
- ann_c_tuple/2, c_nil/0, call_args/1, call_module/1,
- call_name/1, case_arg/1, case_clauses/1, catch_body/1,
- clause_body/1, clause_guard/1, clause_pats/1, cons_hd/1,
- cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
- is_c_atom/1, is_c_int/1, let_arg/1, let_body/1,
- let_vars/1, letrec_body/1, letrec_defs/1, module_defs/1,
- module_defs/1, module_exports/1, pat_vars/1,
- primop_args/1, primop_name/1, receive_action/1,
- receive_clauses/1, receive_timeout/1, seq_arg/1,
- seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
- try_evars/1, try_handler/1, tuple_es/1, type/1,
- values_es/1]).
-
--import(cerl_trees, [get_label/1]).
-
--define(DEF_LIMIT, 4).
-
-%% -export([test/1, test1/1, ttest/1]).
-
-%% ttest(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% analyze(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% Time1 - Time0.
-
-%% test(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% {Esc, _Vars} = analyze(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% io:fwrite("messages: ~p.\n", [Esc]),
-%% Set = sets:from_list(Esc),
-%% H = fun (Node, Ctxt, Cont) ->
-%% Doc = case get_ann(Node) of
-%% [{label, L} | _] ->
-%% B = sets:is_element(L, Set),
-%% bf(Node, Ctxt, Cont, B);
-%% _ ->
-%% bf(Node, Ctxt, Cont, false)
-%% end,
-%% case type(Node) of
-%% cons -> color(Doc);
-%% tuple -> color(Doc);
-%% _ -> Doc
-%% end
-%% end,
-%% {ok, FD} = file:open("out.html",[write]),
-%% Txt = cerl_prettypr:format(T, [{hook, H},{user,false}]),
-%% io:put_chars(FD, "<pre>\n"),
-%% io:put_chars(FD, html(Txt)),
-%% io:put_chars(FD, "</pre>\n"),
-%% file:close(FD),
-%% {ok, Time1 - Time0}.
-
-%% test1(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% {T1, Esc, Vars} = annotate(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% io:fwrite("messages: ~p.\n", [Esc]),
-%% %%% io:fwrite("vars: ~p.\n", [[X || X <- dict:to_list(Vars)]]),
-%% T2 = hhl_transform:transform(T1, Vars),
-%% Set = sets:from_list(Esc),
-%% H = fun (Node, Ctxt, Cont) ->
-%% case get_ann(Node) of
-%% [{label, L} | _] ->
-%% B = sets:is_element(L, Set),
-%% bf(Node, Ctxt, Cont, B);
-%% _ ->
-%% bf(Node, Ctxt, Cont, false)
-%% end
-%% end,
-%% {ok, FD} = file:open("out.html",[write]),
-%% Txt = cerl_prettypr:format(T2, [{hook, H},{user,false}]),
-%% io:put_chars(FD, "<pre>\n"),
-%% io:put_chars(FD, html(Txt)),
-%% io:put_chars(FD, "</pre>\n"),
-%% file:close(FD),
-%% {ok, Time1 - Time0}.
-
-%% html(Cs) ->
-%% html(Cs, []).
-
-%% html([$#, $< | Cs], As) ->
-%% html_1(Cs, [$< | As]);
-%% html([$< | Cs], As) ->
-%% html(Cs, ";tl&" ++ As);
-%% html([$> | Cs], As) ->
-%% html(Cs, ";tg&" ++ As);
-%% html([$& | Cs], As) ->
-%% html(Cs, ";pma&" ++ As);
-%% html([C | Cs], As) ->
-%% html(Cs, [C | As]);
-%% html([], As) ->
-%% lists:reverse(As).
-
-%% html_1([$> | Cs], As) ->
-%% html(Cs, [$> | As]);
-%% html_1([C | Cs], As) ->
-%% html_1(Cs, [C | As]).
-
-%% bf(Node, Ctxt, Cont, B) ->
-%% B0 = cerl_prettypr:get_ctxt_user(Ctxt),
-%% if B /= B0 ->
-%% Ctxt1 = cerl_prettypr:set_ctxt_user(Ctxt, B),
-%% Doc = Cont(Node, Ctxt1),
-%% case B of
-%% true ->
-%% Start = "<b>",
-%% End = "</b>";
-%% false ->
-%% Start = "</b>",
-%% End = "<b>"
-%% end,
-%% markup(Doc, Start, End);
-%% true ->
-%% Cont(Node, Ctxt)
-%% end.
-
-%% color(Doc) ->
-%% % Doc.
-%% markup(Doc, "<font color=blue>", "</font>").
-
-%% markup(Doc, Start, End) ->
-%% prettypr:beside(
-%% prettypr:null_text([$# | Start]),
-%% prettypr:beside(Doc,
-%% prettypr:null_text([$# | End]))).
-
-
-%% =====================================================================
-%% annotate(Tree) -> {Tree1, Escapes, Vars}
-%%
-%% Tree = cerl:cerl()
-%%
-%% Analyzes `Tree' (see `analyze') and appends a term 'escapes', to
-%% the annotation list of each constructor expression node and of
-%% `Tree', corresponding to the escape information derived by the
-%% analysis. Any previous such annotations are removed from `Tree'.
-%% `Tree1' is the modified tree; for details on `OutList',
-%% `Outputs' , `Dependencies', `Escapes' and `Parents', see
-%% `analyze'.
-%%
-%% Note: `Tree' must be annotated with labels in order to use this
-%% function; see `analyze' for details.
-
--type label() :: integer() | 'external' | 'top'.
--type ordset(X) :: [X]. % XXX: TAKE ME OUT
-
--spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict:dict()}.
-
-annotate(Tree) ->
- {Esc0, Vars} = analyze(Tree),
- Esc = sets:from_list(Esc0),
- F = fun (T) ->
- case type(T) of
- literal -> T;
-%%% var ->
-%%% L = get_label(T),
-%%% T1 = ann_escape(T, L, Esc),
-%%% X = dict:fetch(L, Vars),
-%%% set_ann(T1, append_ann({s,X}, get_ann(T1)));
- _ ->
- L = get_label(T),
- ann_escape(T, L, Esc)
- end
- end,
- {cerl_trees:map(F, Tree), Esc0, Vars}.
-
-ann_escape(T, L, Esc) ->
- case sets:is_element(L, Esc) of
- true ->
- set_ann(T, append_ann(escapes, get_ann(T)));
- false ->
- T
- end.
-
-append_ann(Tag, [X | Xs]) ->
- if tuple_size(X) >= 1, element(1, X) =:= Tag ->
- append_ann(Tag, Xs);
- true ->
- [X | append_ann(Tag, Xs)]
- end;
-append_ann(Tag, []) ->
- [Tag].
-
-
-%% =====================================================================
-%% analyze(Tree) -> Escapes
-%%
-%% Tree = cerl:cerl()
-%% Escapes = ordset(Label)
-%% Label = integer() | external | top
-%%
-%% Analyzes a module or an expression represented by `Tree'.
-%%
-%% `Escapes' is the set of labels of constructor expressions in
-%% `Tree' such that the created values may be accessed from outside
-%% `Tree'.
-%%
-%% Note: `Tree' must be annotated with labels (as done by the
-%% function `cerl_trees:label/1') in order to use this function.
-%% The label annotation `{label, L}' (where L should be an integer)
-%% must be the first element of the annotation list of each node in
-%% the tree. Instances of variables bound in `Tree' which denote
-%% the same variable must have the same label; apart from this,
-%% labels should be unique. Constant literals do not need to be
-%% labeled.
-
--record(state, {vars, out, dep, work, funs, k}).
-
-%% Note: We assume that all remote calls and primops return a single
-%% value.
-
-%% The analysis determines which objects (identified by the
-%% corresponding "cons-point" labels in the code) are likely to be
-%% passed in a message. (If so, we say that they "escape".) It is always
-%% safe to assume either case, because the send operation will assure
-%% that things are copied if necessary. This analysis tries to
-%% anticipate that copying will be done.
-%%
-%% Rules:
-%% 1) An object passed as message argument (or part of such an
-%% argument) to a known send-operation, will probably be a message.
-%% 2) A received value is always a message (safe).
-%% 3) The external function can return any object (unsafe).
-%% 4) A function called from the external function can receive any
-%% object (unsafe) as argument.
-%% 5) Unknown functions/operations can return any object (unsafe).
-
-%% We wrap the given syntax tree T in a fun-expression labeled `top',
-%% which is initially in the set of escaped labels. `top' will be
-%% visited at least once.
-%%
-%% We create a separate function labeled `external', defined as:
-%% "'external'/1 = fun () -> Any", which will represent any and all
-%% functions outside T, and which returns the 'unsafe' value.
-
-analyze(Tree) ->
- analyze(Tree, ?DEF_LIMIT).
-
-analyze(Tree, Limit) ->
- {_, _, Esc, Dep, _Par} = cerl_closurean:analyze(Tree),
-%%% io:fwrite("dependencies: ~w.\n", [dict:to_list(Dep)]),
- analyze(Tree, Limit, Dep, Esc).
-
-analyze(Tree, Limit, Dep0, Esc0) ->
- %% Note that we use different name spaces for variable labels and
- %% function/call site labels, so we can reuse some names here. We
- %% assume that the labeling of Tree only uses integers, not atoms.
- Any = ann_c_var([{label, any}], 'Any'),
- External = ann_c_var([{label, external}], {external, 1}),
- ExtFun = ann_c_fun([{label, external}], [], Any),
-%%% io:fwrite("external fun:\n~s.\n",
-%%% [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
- Top = ann_c_var([{label, top}], {top, 0}),
- TopFun = ann_c_fun([{label, top}], [], Tree),
-
- %% The "start fun" just makes the initialisation easier. It is not
- %% itself in the call graph.
- StartFun = ann_c_fun([{label, start}], [],
- c_letrec([{External, ExtFun}, {Top, TopFun}],
- c_nil())),
-%%% io:fwrite("start fun:\n~s.\n",
-%%% [cerl_prettypr:format(StartFun, [{paper, 80}])]),
-
- %% Initialise the Any and Escape variables. Gather a database of all
- %% fun-expressions in Tree and initialise their outputs and parameter
- %% variables. All escaping functions can receive any values as
- %% inputs. Bind all module- and letrec-defined variables to their
- %% corresponding labels.
- Esc = sets:from_list(Esc0),
- Unsafe = unsafe(),
- Empty = empty(),
- Funs0 = dict:new(),
- Vars0 = dict:store(escape, empty(),
- dict:store(any, Unsafe, dict:new())),
- Out0 = dict:new(),
- F = fun (T, S = {Fs, Vs, Os}) ->
- case type(T) of
- 'fun' ->
- L = get_label(T),
- As = fun_vars(T),
- X = case sets:is_element(L, Esc) of
- true -> Unsafe;
- false -> Empty
- end,
- {dict:store(L, T, Fs),
- bind_vars_single(As, X, Vs),
- dict:store(L, none, Os)};
- letrec ->
- {Fs, bind_defs(letrec_defs(T), Vs), Os};
- module ->
- {Fs, bind_defs(module_defs(T), Vs), Os};
- _ ->
- S
- end
- end,
- {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0}, StartFun),
-
- %% Add the dependency for the loop in 'external':
- Dep = add_dep(loop, external, Dep0),
-
- %% Enter the fixpoint iteration at the StartFun.
- St = loop(StartFun, start, #state{vars = Vars,
- out = Out,
- dep = Dep,
- work = init_work(),
- funs = Funs,
- k = Limit}),
- Ms = labels(dict:fetch(escape, St#state.vars)),
- {Ms, St#state.vars}.
-
-loop(T, L, St0) ->
-%%% io:fwrite("analyzing: ~w.\n",[L]),
-%%% io:fwrite("work: ~w.\n", [St0#state.work]),
- Xs0 = dict:fetch(L, St0#state.out),
- {Xs1, St1} = visit(fun_body(T), L, St0),
- Xs = limit(Xs1, St1#state.k),
- {W, M} = case equal(Xs0, Xs) of
- true ->
- {St1#state.work, St1#state.out};
- false ->
-%%% io:fwrite("out (~w) changed: ~w <- ~w.\n",
-%%% [L, Xs, Xs0]),
- M1 = dict:store(L, Xs, St1#state.out),
- case dict:find(L, St1#state.dep) of
- {ok, S} ->
- {add_work(set__to_list(S), St1#state.work),
- M1};
- error ->
- {St1#state.work, M1}
- end
- end,
- St2 = St1#state{out = M},
- case take_work(W) of
- {ok, L1, W1} ->
- T1 = dict:fetch(L1, St2#state.funs),
- loop(T1, L1, St2#state{work = W1});
- none ->
- St2
- end.
-
-visit(T, L, St) ->
-%%% io:fwrite("visiting: ~w.\n",[type(T)]),
- case type(T) of
- literal ->
- %% This is (or should be) a constant, even if it's compound,
- %% so it's bugger all whether it is sent or not.
- case cerl:concrete(T) of
- [] -> {[empty()], St};
- X when is_atom(X) -> {[empty()], St};
- X when is_integer(X) -> {[empty()], St};
- X when is_float(X) -> {[empty()], St};
- _ ->
- exit({not_literal, T})
- end;
- var ->
- %% If a variable is not already in the store here, it must
- %% be free in the program.
- L1 = get_label(T),
- Vars = St#state.vars,
- case dict:find(L1, Vars) of
- {ok, X} ->
- {[X], St};
- error ->
-%%% io:fwrite("free var: ~w.\n",[L1]),
- X = unsafe(),
- St1 = St#state{vars = dict:store(L1, X, Vars)},
- {[X], St1}
- end;
- 'fun' ->
- %% Must revisit the fun also, because its environment might
- %% have changed. (We don't keep track of such dependencies.)
- L1 = get_label(T),
- St1 = St#state{work = add_work([L1], St#state.work)},
- %% Currently, lambda expressions can only be locally
- %% allocated, and therefore we have to force copying by
- %% treating them as "unsafe" for now.
- {[unsafe()], St1};
- %% {[singleton(L1)], St1};
- values ->
- visit_list(values_es(T), L, St);
- cons ->
- {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
- L1 = get_label(T),
- X = make_cons(L1, X1, X2),
- %% Also store the values of the elements.
- Hd = get_hd(X),
- Tl = get_tl(X),
- St2 = St1#state{vars = dict:store(L1, [Hd, Tl], St1#state.vars)},
- {[X], St2};
- tuple ->
- {Xs, St1} = visit_list(tuple_es(T), L, St),
- L1 = get_label(T),
- %% Also store the values of the elements.
- St2 = St1#state{vars = dict:store(L1, Xs, St1#state.vars)},
- {[struct(L1, Xs)], St2};
- 'let' ->
- {Xs, St1} = visit(let_arg(T), L, St),
- Vars = bind_vars(let_vars(T), Xs, St1#state.vars),
- visit(let_body(T), L, St1#state{vars = Vars});
- seq ->
- {_, St1} = visit(seq_arg(T), L, St),
- visit(seq_body(T), L, St1);
- apply ->
- {_F, St1} = visit(apply_op(T), L, St),
- {As, St2} = visit_list(apply_args(T), L, St1),
- L1 = get_label(T),
- Ls = get_deps(L1, St#state.dep),
- Out = St2#state.out,
- Xs1 = join_list([dict:fetch(X, Out) || X <- Ls]),
- {Xs1, call_site(Ls, As, St2)};
- call ->
- M = call_module(T),
- F = call_name(T),
- As = call_args(T),
- {_, St1} = visit(M, L, St),
- {_, St2} = visit(F, L, St1),
- {Xs, St3} = visit_list(As, L, St2),
- L1 = get_label(T),
- remote_call(M, F, Xs, As, L1, St3);
- primop ->
- As = primop_args(T),
- {Xs, St1} = visit_list(As, L, St),
- F = atom_val(primop_name(T)),
- primop_call(F, length(Xs), Xs, As, St1);
- 'case' ->
- {Xs, St1} = visit(case_arg(T), L, St),
- visit_clauses(Xs, case_clauses(T), L, St1);
- 'receive' ->
- %% The received value is of course a message, so it
- %% is 'empty()', not 'unsafe()'.
- X = empty(),
- {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St),
- {_, St2} = visit(receive_timeout(T), L, St1),
- {Xs2, St3} = visit(receive_action(T), L, St2),
- {join(Xs1, Xs2), St3};
- 'try' ->
- {Xs1, St1} = visit(try_arg(T), L, St),
- X = unsafe(),
- Vars = bind_vars(try_vars(T), Xs1, St1#state.vars),
- {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}),
- EVars = bind_vars(try_evars(T), [X, X, X], St2#state.vars),
- {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = EVars}),
- {join(Xs2, Xs3), St3};
- 'catch' ->
- %% If we catch an exception, we can get unsafe data.
- {Xs, St1} = visit(catch_body(T), L, St),
- {join([unsafe()], Xs), St1};
- binary ->
- %% Binaries are heap objects, but we don't have special
- %% shared-heap allocation operators for them at the moment.
- %% They must therefore be treated as unsafe.
- {_, St1} = visit_list(binary_segments(T), L, St),
- {[unsafe()], St1};
- bitstr ->
- %% The other fields are constant literals.
- {_, St1} = visit(bitstr_val(T), L, St),
- {_, St2} = visit(bitstr_size(T), L, St1),
- {none, St2};
- letrec ->
- %% All the bound funs should be revisited, because the
- %% environment might have changed.
- Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
- St1 = St#state{work = add_work(Ls, St#state.work)},
- visit(letrec_body(T), L, St1);
- module ->
- %% We regard a module as a tuple of function variables in
- %% the body of a `letrec'.
- visit(c_letrec(module_defs(T),
- ann_c_tuple([{label, get_label(T)}],
- module_exports(T))),
- L, St)
- end.
-
-visit_clause(T, Xs, L, St) ->
- Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
- {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}),
- visit(clause_body(T), L, St1).
-
-%% We assume correct value-list typing.
-
-visit_list([T | Ts], L, St) ->
- {Xs, St1} = visit(T, L, St),
- {Xs1, St2} = visit_list(Ts, L, St1),
- X = case Xs of
- [X1] -> X1;
- _ -> empty()
- end,
- {[X | Xs1], St2};
-visit_list([], _L, St) ->
- {[], St}.
-
-visit_clauses(Xs, [T | Ts], L, St) ->
- {Xs1, St1} = visit_clause(T, Xs, L, St),
- {Xs2, St2} = visit_clauses(Xs, Ts, L, St1),
- {join(Xs1, Xs2), St2};
-visit_clauses(_, [], _L, St) ->
- {none, St}.
-
-bind_defs([{V, F} | Ds], Vars) ->
- bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)), Vars));
-bind_defs([], Vars) ->
- Vars.
-
-bind_pats(Ps, none, Vars) ->
- bind_pats_single(Ps, empty(), Vars);
-bind_pats(Ps, Xs, Vars) ->
- if length(Xs) =:= length(Ps) ->
- bind_pats_list(Ps, Xs, Vars);
- true ->
- bind_pats_single(Ps, empty(), Vars)
- end.
-
-%% The lists might not be of the same length.
-
-bind_pats_list([P | Ps], [X | Xs], Vars) ->
- bind_pats_list(Ps, Xs, bind_pat_vars(P, X, Vars));
-bind_pats_list(Ps, [], Vars) ->
- bind_pats_single(Ps, empty(), Vars);
-bind_pats_list([], _, Vars) ->
- Vars.
-
-bind_pats_single([P | Ps], X, Vars) ->
- bind_pats_single(Ps, X, bind_pat_vars(P, X, Vars));
-bind_pats_single([], _X, Vars) ->
- Vars.
-
-bind_pat_vars(P, X, Vars) ->
- case type(P) of
- var ->
- dict:store(get_label(P), X, Vars);
- literal ->
- Vars;
- cons ->
- bind_pats_list([cons_hd(P), cons_tl(P)],
- [get_hd(X), get_tl(X)], Vars);
- tuple ->
- case elements(X) of
- none ->
- bind_vars_single(pat_vars(P), X, Vars);
- Xs ->
- bind_pats_list(tuple_es(P), Xs, Vars)
- end;
- binary ->
- %% See the handling of binary-expressions.
- bind_pats_single(binary_segments(P), unsafe(), Vars);
- bitstr ->
- %% See the handling of binary-expressions.
- bind_pats_single([bitstr_val(P), bitstr_size(P)],
- unsafe(), Vars);
- alias ->
- P1 = alias_pat(P),
- Vars1 = bind_pat_vars(P1, X, Vars),
- dict:store(get_label(alias_var(P)), X, Vars1)
- end.
-
-%%% %% This is the "exact" version of list representation, which simply
-%%% %% mimics the actual cons, head and tail operations.
-%%% make_cons(L, X1, X2) ->
-%%% struct(L1, [X1, X2]).
-%%% get_hd(X) ->
-%%% case elements(X) of
-%%% none -> X;
-%%% [X1 | _] -> X1;
-%%% _ -> empty()
-%%% end.
-%%% get_tl(X) ->
-%%% case elements(X) of
-%%% none -> X;
-%%% [_, X2 | _] -> X2;
-%%% _ -> empty()
-%%% end.
-
-%% This version does not unnecessarily confuse spine labels with element
-%% labels, and is safe. However, it loses precision if cons cells are
-%% used for other things than proper lists.
-
-make_cons(L, X1, X2) ->
- %% join subtypes and cons locations
- join_single(struct(L, [X1]), X2).
-
-get_hd(X) ->
- case elements(X) of
- none -> X;
- [X1 | _] -> X1; % First element represents list subtype.
- _ -> empty()
- end.
-
-get_tl(X) -> X. % Tail of X has same type as X.
-
-bind_vars(Vs, none, Vars) ->
- bind_vars_single(Vs, empty(), Vars);
-bind_vars(Vs, Xs, Vars) ->
- if length(Vs) =:= length(Xs) ->
- bind_vars_list(Vs, Xs, Vars);
- true ->
- bind_vars_single(Vs, empty(), Vars)
- end.
-
-bind_vars_list([V | Vs], [X | Xs], Vars) ->
- bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
-bind_vars_list([], [], Vars) ->
- Vars.
-
-bind_vars_single([V | Vs], X, Vars) ->
- bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
-bind_vars_single([], _X, Vars) ->
- Vars.
-
-%% This handles a call site, updating parameter variables with respect
-%% to the actual parameters. The 'external' function is handled
-%% specially, since it can get an arbitrary number of arguments. For our
-%% purposes here, calls to the external function can be ignored.
-
-call_site(Ls, Xs, St) ->
-%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]),
- {W, V} = call_site(Ls, Xs, St#state.work, St#state.vars,
- St#state.funs, St#state.k),
- St#state{work = W, vars = V}.
-
-call_site([external | Ls], Xs, W, V, Fs, Limit) ->
- call_site(Ls, Xs, W, V, Fs, Limit);
-call_site([L | Ls], Xs, W, V, Fs, Limit) ->
- Vs = fun_vars(dict:fetch(L, Fs)),
- case bind_args(Vs, Xs, V, Limit) of
- {V1, true} ->
- call_site(Ls, Xs, add_work([L], W), V1, Fs, Limit);
- {V1, false} ->
- call_site(Ls, Xs, W, V1, Fs, Limit)
- end;
-call_site([], _, W, V, _, _) ->
- {W, V}.
-
-add_dep(Source, Target, Deps) ->
- case dict:find(Source, Deps) of
- {ok, X} ->
- case set__is_member(Target, X) of
- true ->
- Deps;
- false ->
-%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
- dict:store(Source, set__add(Target, X), Deps)
- end;
- error ->
-%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
- dict:store(Source, set__singleton(Target), Deps)
- end.
-
-%% If the arity does not match the call, nothing is done here.
-
-bind_args(Vs, Xs, Vars, Limit) ->
- if length(Vs) =:= length(Xs) ->
- bind_args(Vs, Xs, Vars, Limit, false);
- true ->
- {Vars, false}
- end.
-
-bind_args([V | Vs], [X | Xs], Vars, Limit, Ch) ->
- L = get_label(V),
- {Vars1, Ch1} = bind_arg(L, X, Vars, Limit, Ch),
- bind_args(Vs, Xs, Vars1, Limit, Ch1);
-bind_args([], [], Vars, _Limit, Ch) ->
- {Vars, Ch}.
-
-%% bind_arg(L, X, Vars, Limit) ->
-%% bind_arg(L, X, Vars, Limit, false).
-
-bind_arg(L, X, Vars, Limit, Ch) ->
- X0 = dict:fetch(L, Vars),
- X1 = limit_single(join_single(X, X0), Limit),
- case equal_single(X0, X1) of
- true ->
- {Vars, Ch};
- false ->
-%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n",
-%%% [L, X1, X0, X]),
- {dict:store(L, X1, Vars), true}
- end.
-
-%% This handles escapes from things like primops and remote calls.
-
-escape(Xs, Ns, St) ->
- escape(Xs, Ns, 1, St).
-
-escape([_ | Xs], Ns=[N1 | _], N, St) when is_integer(N1), N1 > N ->
- escape(Xs, Ns, N + 1, St);
-escape([X | Xs], [N | Ns], N, St) ->
- Vars = St#state.vars,
- X0 = dict:fetch(escape, Vars),
- X1 = join_single(X, X0),
- case equal_single(X0, X1) of
- true ->
- escape(Xs, Ns, N + 1, St);
- false ->
-%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
- Vars1 = dict:store(escape, X1, Vars),
- escape(Xs, Ns, N + 1, St#state{vars = Vars1})
- end;
-escape(Xs, [_ | Ns], N, St) ->
- escape(Xs, Ns, N + 1, St);
-escape(_, _, _, St) ->
- St.
-
-%% Handle primop calls: (At present, we assume that all unknown calls
-%% yield exactly one value. This might have to be changed.)
-
-primop_call(F, A, Xs, _As, St0) ->
- %% St1 = case is_escape_op(F, A) of
- %% [] -> St0;
- %% Ns -> escape(Xs, Ns, St0)
- %% end,
- St1 = St0,
- case is_imm_op(F, A) of
- true ->
- {[empty()], St1};
- false ->
- call_unknown(Xs, St1)
- end.
-
-%% Handle remote-calls: (At present, we assume that all unknown calls
-%% yield exactly one value. This might have to be changed.)
-
-remote_call(M, F, Xs, As, L, St) ->
- case is_c_atom(M) andalso is_c_atom(F) of
- true ->
- remote_call_1(atom_val(M), atom_val(F), length(Xs),
- Xs, As, L, St);
- false ->
- %% Unknown function
- call_unknown(Xs, St)
- end.
-
-%% When calling an unknown function, we assume that the result does
-%% *not* contain any of the constructors in its arguments (but it could
-%% return locally allocated data that we don't know about). Note that
-%% even a "pure" function can still cons up new data.
-
-call_unknown(_Xs, St) ->
- {[unsafe()], St}.
-
-%% We need to handle some important standard functions in order to get
-%% decent precision.
-%% TODO: foldl, map, mapfoldl
-
-remote_call_1(erlang, hd, 1, [X], _As, _L, St) ->
- {[get_hd(X)], St};
-remote_call_1(erlang, tl, 1, [X], _As, _L, St) ->
- {[get_tl(X)], St};
-remote_call_1(erlang, element, 2, [_,X], [N|_], _L, St) ->
- case elements(X) of
- none -> {[X], St};
- Xs ->
- case is_c_int(N) of
- true ->
- N1 = int_val(N),
- if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
- {[nth(N1, Xs)], St};
- true ->
- {none, St}
- end;
- false ->
- %% Even if we don't know which element is selected,
- %% we know that the top level is never part of the
- %% returned value.
- {[join_single_list(Xs)], St}
- end
- end;
-remote_call_1(erlang, setelement, 3, [_,X, Y], [N|_], L, St) ->
- %% The constructor gets the label of the call operation.
- case elements(X) of
- none -> {[join_single(singleton(L), join_single(X, Y))], St};
- Xs ->
- case is_c_int(N) of
- true ->
- N1 = int_val(N),
- if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
- Xs1 = set_nth(N1, Y, Xs),
- {[struct(L, Xs1)], St};
- true ->
- {none, St}
- end;
- false ->
- %% Even if we don't know which element is selected,
- %% we know that the top level is never part of the
- %% returned value (a new tuple is always created).
- Xs1 = [join_single(Y, X1) || X1 <- Xs],
- {[struct(L, Xs1)], St}
- end
- end;
-remote_call_1(erlang, '++', 2, [X1,X2], _As, _L, St) ->
- %% Note: this is unsafe for non-proper lists! (See make_cons/3).
- %% No safe version is implemented.
- {[join_single(X1, X2)], St};
-remote_call_1(erlang, '--', 2, [X1,_X2], _As, _L, St) ->
- {[X1], St};
-remote_call_1(lists, append, 2, Xs, As, L, St) ->
- remote_call_1(erlang, '++', 2, Xs, As, L, St);
-remote_call_1(lists, subtract, 2, Xs, As, L, St) ->
- remote_call_1(erlang, '--', 2, Xs, As, L, St);
-remote_call_1(M, F, A, Xs, _As, _L, St0) ->
- St1 = case is_escape_op(M, F, A) of
- [] -> St0;
- Ns -> escape(Xs, Ns, St0)
- end,
- case is_imm_op(M, F, A) of
- true ->
- {[empty()], St1};
- false ->
- call_unknown(Xs, St1)
- end.
-
-%% 1-based n:th-element list selector and update function.
-
-nth(1, [X | _Xs]) -> X;
-nth(N, [_X | Xs]) when N > 1 -> nth(N - 1, Xs).
-
-set_nth(1, Y, [_X | Xs]) -> [Y | Xs];
-set_nth(N, Y, [X | Xs]) when N > 1 -> [X | set_nth(N - 1, Y, Xs)].
-
-%% Domain: none | [V], where V = {S, none} | {S, [V]}, S = set(integer()).
-
-join(none, Xs2) -> Xs2;
-join(Xs1, none) -> Xs1;
-join(Xs1, Xs2) ->
- if length(Xs1) =:= length(Xs2) ->
- join_1(Xs1, Xs2);
- true ->
- none
- end.
-
-join_1([X1 | Xs1], [X2 | Xs2]) ->
- [join_single(X1, X2) | join_1(Xs1, Xs2)];
-join_1([], []) ->
- [].
-
-join_list([Xs | Xss]) ->
- join(Xs, join_list(Xss));
-join_list([]) ->
- none.
-
-empty() -> {set__new(), []}.
-
-singleton(X) -> {set__singleton(X), []}.
-
-struct(X, Xs) -> {set__singleton(X), Xs}.
-
-elements({_, Xs}) -> Xs.
-
-unsafe() -> {set__singleton(unsafe), none}.
-
-equal(none, none) -> true;
-equal(none, _) -> false;
-equal(_, none) -> false;
-equal(X1, X2) -> equal_1(X1, X2).
-
-equal_1([X1 | Xs1], [X2 | Xs2]) ->
- equal_single(X1, X2) andalso equal_1(Xs1, Xs2);
-equal_1([], []) -> true;
-equal_1(_, _) -> false.
-
-equal_single({S1, none}, {S2, none}) ->
- set__equal(S1, S2);
-equal_single({_, none}, _) ->
- false;
-equal_single(_, {_, none}) ->
- false;
-equal_single({S1, Vs1}, {S2, Vs2}) ->
- set__equal(S1, S2) andalso equal_single_lists(Vs1, Vs2).
-
-equal_single_lists([X1 | Xs1], [X2 | Xs2]) ->
- equal_single(X1, X2) andalso equal_single_lists(Xs1, Xs2);
-equal_single_lists([], []) ->
- true;
-equal_single_lists(_, _) ->
- false.
-
-join_single({S, none}, V) ->
- {set__union(S, labels(V)), none};
-join_single(V, {S, none}) ->
- {set__union(S, labels(V)), none};
-join_single({S1, Vs1}, {S2, Vs2}) ->
- {set__union(S1, S2), join_single_lists(Vs1, Vs2)}.
-
-join_single_list([V | Vs]) ->
- join_single(V, join_single_list(Vs));
-join_single_list([]) ->
- empty().
-
-%% If one list has more elements that the other, and N is the length of
-%% the longer list, then the result has N elements.
-
-join_single_lists([V1], [V2]) ->
- [join_single(V1, V2)];
-join_single_lists([V1 | Vs1], [V2 | Vs2]) ->
- [join_single(V1, V2) | join_single_lists(Vs1, Vs2)];
-join_single_lists([], Vs) -> Vs;
-join_single_lists(Vs, []) -> Vs.
-
-collapse(V) ->
- {labels(V), none}.
-
-%% collapse_list([]) ->
-%% empty();
-%% collapse_list(Vs) ->
-%% {labels_list(Vs), none}.
-
-labels({S, none}) -> S;
-labels({S, []}) -> S;
-labels({S, Vs}) -> set__union(S, labels_list(Vs)).
-
-labels_list([V]) ->
- labels(V);
-labels_list([V | Vs]) ->
- set__union(labels(V), labels_list(Vs)).
-
-limit(none, _K) -> none;
-limit(X, K) -> limit_list(X, K).
-
-limit_list([X | Xs], K) ->
- [limit_single(X, K) | limit_list(Xs, K)];
-limit_list([], _) ->
- [].
-
-limit_single({_, none} = V, _K) ->
- V;
-limit_single({_, []} = V, _K) ->
- V;
-limit_single({S, Vs}, K) when K > 0 ->
- {S, limit_list(Vs, K - 1)};
-limit_single(V, _K) ->
- collapse(V).
-
-%% Set abstraction for label sets in the domain.
-
-%% set__is_empty([]) -> true;
-%% set__is_empty(_) -> false.
-
-set__new() -> [].
-
-set__singleton(X) -> [X].
-
-set__to_list(S) -> S.
-
-%% set__from_list(S) -> ordsets:from_list(S).
-
-set__union(X, Y) -> ordsets:union(X, Y).
-
-set__add(X, S) -> ordsets:add_element(X, S).
-
-set__is_member(X, S) -> ordsets:is_element(X, S).
-
-%% set__subtract(X, Y) -> ordsets:subtract(X, Y).
-
-set__equal(X, Y) -> X =:= Y.
-
-%% A simple but efficient functional queue.
-
-queue__new() -> {[], []}.
-
-queue__put(X, {In, Out}) -> {[X | In], Out}.
-
-queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
-queue__get({[], _}) -> empty;
-queue__get({In, _}) ->
- [X | In1] = lists:reverse(In),
- {ok, X, {[], In1}}.
-
-%% The work list - a queue without repeated elements.
-
-init_work() ->
- {queue__new(), sets:new()}.
-
-add_work(Ls, {Q, Set}) ->
- add_work(Ls, Q, Set).
-
-%% Note that the elements are enqueued in order.
-
-add_work([L | Ls], Q, Set) ->
- case sets:is_element(L, Set) of
- true ->
- add_work(Ls, Q, Set);
- false ->
- add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
- end;
-add_work([], Q, Set) ->
- {Q, Set}.
-
-take_work({Queue0, Set0}) ->
- case queue__get(Queue0) of
- {ok, L, Queue1} ->
- Set1 = sets:del_element(L, Set0),
- {ok, L, {Queue1, Set1}};
- empty ->
- none
- end.
-
-get_deps(L, Dep) ->
- case dict:find(L, Dep) of
- {ok, Ls} -> Ls;
- error -> []
- end.
-
-%% Escape operators may let their arguments escape. For this analysis,
-%% only send-operations are considered as causing escapement, and only
-%% in specific arguments.
-
-%% is_escape_op(_F, _A) -> [].
-
--spec is_escape_op(atom(), atom(), arity()) -> [arity()].
-
-is_escape_op(erlang, '!', 2) -> [2];
-is_escape_op(erlang, send, 2) -> [2];
-is_escape_op(erlang, spawn, 1) -> [1];
-is_escape_op(erlang, spawn, 3) -> [3];
-is_escape_op(erlang, spawn, 4) -> [4];
-is_escape_op(erlang, spawn_link, 3) -> [3];
-is_escape_op(erlang, spawn_link, 4) -> [4];
-is_escape_op(_M, _F, _A) -> [].
-
-%% "Immediate" operators will never return heap allocated data. This is
-%% of course true for operators that never return, like 'exit/1'. (Note
-%% that floats are always heap allocated objects, and that most integer
-%% arithmetic can return a bignum on the heap.)
-
--spec is_imm_op(atom(), arity()) -> boolean().
-
-is_imm_op(match_fail, 1) -> true;
-is_imm_op(_, _) -> false.
-
--spec is_imm_op(atom(), atom(), arity()) -> boolean().
-
-is_imm_op(erlang, self, 0) -> true;
-is_imm_op(erlang, '=:=', 2) -> true;
-is_imm_op(erlang, '==', 2) -> true;
-is_imm_op(erlang, '=/=', 2) -> true;
-is_imm_op(erlang, '/=', 2) -> true;
-is_imm_op(erlang, '<', 2) -> true;
-is_imm_op(erlang, '=<', 2) -> true;
-is_imm_op(erlang, '>', 2) -> true;
-is_imm_op(erlang, '>=', 2) -> true;
-is_imm_op(erlang, 'and', 2) -> true;
-is_imm_op(erlang, 'or', 2) -> true;
-is_imm_op(erlang, 'xor', 2) -> true;
-is_imm_op(erlang, 'not', 1) -> true;
-is_imm_op(erlang, is_alive, 0) -> true;
-is_imm_op(erlang, is_atom, 1) -> true;
-is_imm_op(erlang, is_binary, 1) -> true;
-is_imm_op(erlang, is_builtin, 3) -> true;
-is_imm_op(erlang, is_float, 1) -> true;
-is_imm_op(erlang, is_function, 1) -> true;
-is_imm_op(erlang, is_integer, 1) -> true;
-is_imm_op(erlang, is_list, 1) -> true;
-is_imm_op(erlang, is_number, 1) -> true;
-is_imm_op(erlang, is_pid, 1) -> true;
-is_imm_op(erlang, is_port, 1) -> true;
-is_imm_op(erlang, is_process_alive, 1) -> true;
-is_imm_op(erlang, is_reference, 1) -> true;
-is_imm_op(erlang, is_tuple, 1) -> true;
-is_imm_op(erlang, length, 1) -> true; % never a bignum
-is_imm_op(erlang, list_to_atom, 1) -> true;
-is_imm_op(erlang, node, 0) -> true;
-is_imm_op(erlang, node, 1) -> true;
-is_imm_op(erlang, throw, 1) -> true;
-is_imm_op(erlang, exit, 1) -> true;
-is_imm_op(erlang, error, 1) -> true;
-is_imm_op(erlang, error, 2) -> true;
-is_imm_op(_M, _F, _A) -> false.
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 518f67ee1b..48ce641ab9 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -585,6 +585,13 @@ type(erlang, float, 1, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, floor, 1, Xs, Opaques) ->
strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Primop, needs to be somewhere.
+type(erlang, build_stacktrace, 0, _, _Opaques) ->
+ t_list(t_tuple([t_module(),
+ t_atom(),
+ t_sup([t_arity(),t_list()]),
+ t_list(t_sup([t_tuple([t_atom('file'),t_string()]),
+ t_tuple([t_atom('line'),t_pos_integer()])]))]));
%% Guard bif, needs to be here.
type(erlang, hd, 1, Xs, Opaques) ->
strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques);
@@ -658,6 +665,8 @@ type(erlang, is_map, 1, Xs, Opaques) ->
check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end,
t_map(), Opaques) end,
strict(erlang, is_map, 1, Xs, Fun, Opaques);
+type(erlang, is_map_key, 2, Xs, Opaques) ->
+ type(maps, is_key, 2, Xs, Opaques);
type(erlang, is_number, 1, Xs, Opaques) ->
Fun = fun (X) ->
check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end,
@@ -763,6 +772,9 @@ type(erlang, length, 1, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, map_size, 1, Xs, Opaques) ->
type(maps, size, 1, Xs, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, map_get, 2, Xs, Opaques) ->
+ type(maps, get, 2, Xs, Opaques);
type(erlang, make_fun, 3, Xs, Opaques) ->
strict(erlang, make_fun, 3, Xs,
fun ([_, _, Arity]) ->
@@ -1701,24 +1713,6 @@ type(maps, size, 1, Xs, Opaques) ->
t_from_range(LowerBound, UpperBound)
end
end, Opaques);
-type(maps, to_list, 1, Xs, Opaques) ->
- strict(maps, to_list, 1, Xs,
- fun ([Map]) ->
- DefK = t_map_def_key(Map, Opaques),
- DefV = t_map_def_val(Map, Opaques),
- Pairs = t_map_entries(Map, Opaques),
- EType = lists:foldl(
- fun({K,_,V},EType0) ->
- case t_is_none(V) of
- true -> t_subtract(EType0, t_tuple([K,t_any()]));
- false -> t_sup(EType0, t_tuple([K,V]))
- end
- end, t_tuple([DefK, DefV]), Pairs),
- case t_is_none(EType) of
- true -> t_nil();
- false -> t_list(EType)
- end
- end, Opaques);
type(maps, update, 3, Xs, Opaques) ->
strict(maps, update, 3, Xs,
fun ([Key, Value, Map]) ->
@@ -2354,6 +2348,9 @@ arg_types(erlang, float, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, floor, 1) ->
[t_number()];
+%% Primop, needs to be somewhere.
+arg_types(erlang, build_stacktrace, 0) ->
+ [];
%% Guard bif, needs to be here.
arg_types(erlang, hd, 1) ->
[t_cons()];
@@ -2379,6 +2376,8 @@ arg_types(erlang, is_list, 1) ->
[t_any()];
arg_types(erlang, is_map, 1) ->
[t_any()];
+arg_types(erlang, is_map_key, 2) ->
+ [t_any(), t_map()];
arg_types(erlang, is_number, 1) ->
[t_any()];
arg_types(erlang, is_pid, 1) ->
@@ -2399,6 +2398,9 @@ arg_types(erlang, length, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, map_size, 1) ->
[t_map()];
+%% Guard bif, needs to be here.
+arg_types(erlang, map_get, 2) ->
+ [t_any(), t_map()];
arg_types(erlang, make_fun, 3) ->
[t_atom(), t_atom(), t_arity()];
arg_types(erlang, make_tuple, 2) ->
@@ -2651,8 +2653,6 @@ arg_types(maps, put, 3) ->
[t_any(), t_any(), t_map()];
arg_types(maps, size, 1) ->
[t_map()];
-arg_types(maps, to_list, 1) ->
- [t_map()];
arg_types(maps, update, 3) ->
[t_any(), t_any(), t_map()];
arg_types(M, F, A) when is_atom(M), is_atom(F),
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 2b290b2f23..9abb4d31d9 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -108,13 +108,14 @@
t_is_bitstr/1, t_is_bitstr/2,
t_is_bitwidth/1,
t_is_boolean/1, t_is_boolean/2,
- %% t_is_byte/1,
- %% t_is_char/1,
+ t_is_byte/1,
+ t_is_char/1,
t_is_cons/1, t_is_cons/2,
t_is_equal/2,
t_is_fixnum/1,
t_is_float/1, t_is_float/2,
t_is_fun/1, t_is_fun/2,
+ t_is_identifier/1,
t_is_instance/2,
t_is_integer/1, t_is_integer/2,
t_is_list/1,
@@ -216,18 +217,7 @@
cache__new/0
]).
-%%-define(DO_ERL_TYPES_TEST, true).
--compile({no_auto_import,[min/2,max/2]}).
-
--ifdef(DO_ERL_TYPES_TEST).
--export([test/0]).
--else.
--define(NO_UNUSED, true).
--endif.
-
--ifndef(NO_UNUSED).
--export([t_is_identifier/1]).
--endif.
+-compile({no_auto_import,[min/2,max/2,map_get/2]}).
-export_type([erl_type/0, opaques/0, type_table/0,
var_table/0, cache/0]).
@@ -1190,12 +1180,10 @@ is_fun(_) -> false.
t_identifier() ->
?identifier(?any).
--ifdef(DO_ERL_TYPES_TEST).
--spec t_is_identifier(erl_type()) -> erl_type().
+-spec t_is_identifier(erl_type()) -> boolean().
t_is_identifier(?identifier(_)) -> true;
t_is_identifier(_) -> false.
--endif.
%%------------------------------------
@@ -1366,7 +1354,6 @@ is_integer1(_) -> false.
t_byte() ->
?byte.
--ifdef(DO_ERL_TYPES_TEST).
-spec t_is_byte(erl_type()) -> boolean().
t_is_byte(?int_range(neg_inf, _)) -> false;
@@ -1376,7 +1363,6 @@ t_is_byte(?int_range(From, To))
t_is_byte(?int_set(Set)) ->
(set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE);
t_is_byte(_) -> false.
--endif.
%%------------------------------------
@@ -4257,13 +4243,13 @@ t_to_string(?identifier(Set), _RecDict) ->
case Set of
?any -> "identifier()";
_ ->
- string:join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ")
+ flat_join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ")
end;
t_to_string(?opaque(Set), RecDict) ->
- string:join([opaque_type(Mod, Name, Args, S, RecDict) ||
- #opaque{mod = Mod, name = Name, struct = S, args = Args}
- <- set_to_list(Set)],
- " | ");
+ flat_join([opaque_type(Mod, Name, Args, S, RecDict) ||
+ #opaque{mod = Mod, name = Name, struct = S, args = Args}
+ <- set_to_list(Set)],
+ " | ");
t_to_string(?matchstate(Pres, Slots), RecDict) ->
flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict),
t_to_string(Slots,RecDict)]);
@@ -4354,9 +4340,9 @@ t_to_string(?map(Pairs0,DefK,DefV), RecDict) ->
end end,
StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs],
StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs],
- "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand]
- ++ [K ++ "=>" ++ V||{K,V}<-StrOpt]
- ++ ExtraEl, ", ") ++ "}";
+ "#{" ++ flat_join([K ++ ":=" ++ V||{K,V}<-StrMand]
+ ++ [K ++ "=>" ++ V||{K,V}<-StrOpt]
+ ++ ExtraEl, ", ") ++ "}";
t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
t_to_string(?tuple(Elements, _Arity, ?any), RecDict) ->
"{" ++ comma_sequence(Elements, RecDict) ++ "}";
@@ -4379,7 +4365,7 @@ t_to_string(?var(Id), _RecDict) when is_integer(Id) ->
record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
- "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}".
+ "#" ++ atom_to_string(Tag) ++ "{" ++ flat_join(FieldStrings, ",") ++ "}".
record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs],
RecDict, Acc) ->
@@ -4405,7 +4391,7 @@ record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) ->
{ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict),
%% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]),
FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []),
- string:join(FieldDiffs, " and ").
+ flat_join(FieldDiffs, " and ").
field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) ->
%% Don't care about opacity for now.
@@ -4425,11 +4411,11 @@ comma_sequence(Types, RecDict) ->
true -> "_";
false -> t_to_string(T, RecDict)
end || T <- Types],
- string:join(List, ",").
+ flat_join(List, ",").
union_sequence(Types, RecDict) ->
List = [t_to_string(T, RecDict) || T <- Types],
- string:join(List, " | ").
+ flat_join(List, " | ").
-ifdef(DEBUG).
opaque_type(Mod, Name, _Args, S, RecDict) ->
@@ -5269,7 +5255,7 @@ t_form_to_string({ann_type, _L, [Var, Type]}) ->
t_form_to_string({paren_type, _L, [Type]}) ->
flat_format("(~ts)", [t_form_to_string(Type)]);
t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
- ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")",
+ ArgString = "(" ++ flat_join(t_form_to_string_list(Args), ",") ++ ")",
flat_format("~w:~tw", [Mod, Name]) ++ ArgString;
t_form_to_string({type, _L, arity, []}) -> "arity()";
t_form_to_string({type, _L, binary, []}) -> "binary()";
@@ -5292,7 +5278,7 @@ t_form_to_string({type, _L, 'fun', []}) -> "fun()";
t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) ->
"fun(...) -> " ++ t_form_to_string(Range);
t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) ->
- "fun((" ++ string:join(t_form_to_string_list(Domain), ",") ++ ") -> "
+ "fun((" ++ flat_join(t_form_to_string_list(Domain), ",") ++ ") -> "
++ t_form_to_string(Range) ++ ")";
t_form_to_string({type, _L, iodata, []}) -> "iodata()";
t_form_to_string({type, _L, iolist, []}) -> "iolist()";
@@ -5300,7 +5286,7 @@ t_form_to_string({type, _L, list, [Type]}) ->
"[" ++ t_form_to_string(Type) ++ "]";
t_form_to_string({type, _L, map, any}) -> "map()";
t_form_to_string({type, _L, map, Args}) ->
- "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}";
+ "#{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) ->
t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val);
t_form_to_string({type, _L, map_field_exact, [Key, Val]}) ->
@@ -5312,7 +5298,7 @@ t_form_to_string({type, _L, nonempty_list, [Type]}) ->
"[" ++ t_form_to_string(Type) ++ ",...]";
t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()";
t_form_to_string({type, _L, product, Elements}) ->
- "<" ++ string:join(t_form_to_string_list(Elements), ",") ++ ">";
+ "<" ++ flat_join(t_form_to_string_list(Elements), ",") ++ ">";
t_form_to_string({type, _L, range, [From, To]} = Type) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
{{integer, _, FromVal}, {integer, _, ToVal}} ->
@@ -5322,7 +5308,7 @@ t_form_to_string({type, _L, range, [From, To]} = Type) ->
t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
flat_format("#~tw{}", [Name]);
t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
- FieldString = string:join(t_form_to_string_list(Fields), ","),
+ FieldString = flat_join(t_form_to_string_list(Fields), ","),
flat_format("#~tw{~ts}", [Name, FieldString]);
t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
flat_format("~tw::~ts", [Name, t_form_to_string(Type)]);
@@ -5330,9 +5316,9 @@ t_form_to_string({type, _L, term, []}) -> "term()";
t_form_to_string({type, _L, timeout, []}) -> "timeout()";
t_form_to_string({type, _L, tuple, any}) -> "tuple()";
t_form_to_string({type, _L, tuple, Args}) ->
- "{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}";
+ "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
t_form_to_string({type, _L, union, Args}) ->
- string:join(t_form_to_string_list(Args), " | ");
+ flat_join(t_form_to_string_list(Args), " | ");
t_form_to_string({type, _L, Name, []} = T) ->
try
M = mod,
@@ -5350,7 +5336,7 @@ t_form_to_string({type, _L, Name, []} = T) ->
end;
t_form_to_string({user_type, _L, Name, List}) ->
flat_format("~tw(~ts)",
- [Name, string:join(t_form_to_string_list(List), ",")]);
+ [Name, flat_join(t_form_to_string_list(List), ",")]);
t_form_to_string({type, L, Name, List}) ->
%% Compatibility: modules compiled before Erlang/OTP 18.0.
t_form_to_string({user_type, L, Name, List}).
@@ -5611,7 +5597,7 @@ set_to_string(Set) ->
true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs '
false -> flat_format("~tw", [X])
end || X <- set_to_list(Set)],
- string:join(L, " | ").
+ flat_join(L, " | ").
set_min([H|_]) -> H.
@@ -5621,6 +5607,9 @@ set_max(Set) ->
flat_format(F, S) ->
lists:flatten(io_lib:format(F, S)).
+flat_join(List, Sep) ->
+ lists:flatten(lists:join(Sep, List)).
+
%%=============================================================================
%%
%% Utilities for the binary type
@@ -5690,173 +5679,3 @@ family(L) ->
var_table__new() ->
maps:new().
-
-%%=============================================================================
-%% Consistency-testing function(s) below
-%%=============================================================================
-
--ifdef(DO_ERL_TYPES_TEST).
-
-test() ->
- Atom1 = t_atom(),
- Atom2 = t_atom(foo),
- Atom3 = t_atom(bar),
- true = t_is_atom(Atom2),
-
- True = t_atom(true),
- False = t_atom(false),
- Bool = t_boolean(),
- true = t_is_boolean(True),
- true = t_is_boolean(Bool),
- false = t_is_boolean(Atom1),
-
- Binary = t_binary(),
- true = t_is_binary(Binary),
-
- Bitstr = t_bitstr(),
- true = t_is_bitstr(Bitstr),
-
- Bitstr1 = t_bitstr(7, 3),
- true = t_is_bitstr(Bitstr1),
- false = t_is_binary(Bitstr1),
-
- Bitstr2 = t_bitstr(16, 8),
- true = t_is_bitstr(Bitstr2),
- true = t_is_binary(Bitstr2),
-
- ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
- ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
-
- Int1 = t_integer(),
- Int2 = t_integer(1),
- Int3 = t_integer(16#ffffffff),
- true = t_is_integer(Int2),
- true = t_is_byte(Int2),
- false = t_is_byte(Int3),
- false = t_is_byte(t_from_range(-1, 1)),
- true = t_is_byte(t_from_range(1, ?MAX_BYTE)),
-
- Tuple1 = t_tuple(),
- Tuple2 = t_tuple(3),
- Tuple3 = t_tuple([Atom1, Int1]),
- Tuple4 = t_tuple([Tuple1, Tuple2]),
- Tuple5 = t_tuple([Tuple3, Tuple4]),
- Tuple6 = t_limit(Tuple5, 2),
- Tuple7 = t_limit(Tuple5, 3),
- true = t_is_tuple(Tuple1),
-
- Port = t_port(),
- Pid = t_pid(),
- Ref = t_reference(),
- Identifier = t_identifier(),
- false = t_is_reference(Port),
- true = t_is_identifier(Port),
-
- Function1 = t_fun(),
- Function2 = t_fun(Pid),
- Function3 = t_fun([], Pid),
- Function4 = t_fun([Port, Pid], Pid),
- Function5 = t_fun([Pid, Atom1], Int2),
- true = t_is_fun(Function3),
-
- List1 = t_list(),
- List2 = t_list(t_boolean()),
- List3 = t_cons(t_boolean(), List2),
- List4 = t_cons(t_boolean(), t_atom()),
- List5 = t_cons(t_boolean(), t_nil()),
- List6 = t_cons_tl(List5),
- List7 = t_sup(List4, List5),
- List8 = t_inf(List7, t_list()),
- List9 = t_cons(),
- List10 = t_cons_tl(List9),
- true = t_is_boolean(t_cons_hd(List5)),
- true = t_is_list(List5),
- false = t_is_list(List4),
-
- Product1 = t_product([Atom1, Atom2]),
- Product2 = t_product([Atom3, Atom1]),
- Product3 = t_product([Atom3, Atom2]),
-
- Union1 = t_sup(Atom2, Atom3),
- Union2 = t_sup(Tuple2, Tuple3),
- Union3 = t_sup(Int2, Atom3),
- Union4 = t_sup(Port, Pid),
- Union5 = t_sup(Union4, Int1),
- Union6 = t_sup(Function1, Function2),
- Union7 = t_sup(Function4, Function5),
- Union8 = t_sup(True, False),
- true = t_is_boolean(Union8),
- Union9 = t_sup(Int2, t_integer(2)),
- true = t_is_byte(Union9),
- Union10 = t_sup(t_tuple([t_atom(true), ?any]),
- t_tuple([t_atom(false), ?any])),
-
- ?any = t_sup(Product3, Function5),
-
- Atom3 = t_inf(Union3, Atom1),
- Union2 = t_inf(Union2, Tuple1),
- Int2 = t_inf(Int1, Union3),
- Union4 = t_inf(Union4, Identifier),
- Port = t_inf(Union5, Port),
- Function4 = t_inf(Union7, Function4),
- ?none = t_inf(Product2, Atom1),
- Product3 = t_inf(Product1, Product2),
- Function5 = t_inf(Union7, Function5),
- true = t_is_byte(t_inf(Union9, t_number())),
- true = t_is_char(t_inf(Union9, t_number())),
-
- io:format("3? ~p ~n", [?int_set([3])]),
-
- RecDict = dict:store({foo, 2}, [bar, baz], dict:new()),
- Record1 = t_from_term({foo, [1,2], {1,2,3}}),
-
- Types = [
- Atom1,
- Atom2,
- Atom3,
- Binary,
- Int1,
- Int2,
- Tuple1,
- Tuple2,
- Tuple3,
- Tuple4,
- Tuple5,
- Tuple6,
- Tuple7,
- Ref,
- Port,
- Pid,
- Identifier,
- List1,
- List2,
- List3,
- List4,
- List5,
- List6,
- List7,
- List8,
- List9,
- List10,
- Function1,
- Function2,
- Function3,
- Function4,
- Function5,
- Product1,
- Product2,
- Record1,
- Union1,
- Union2,
- Union3,
- Union4,
- Union5,
- Union6,
- Union7,
- Union8,
- Union10,
- t_inf(Union10, t_tuple([t_atom(true), t_integer()]))
- ],
- io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]).
-
--endif.
diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile
index 1c774d3357..bd6a7b2f74 100644
--- a/lib/hipe/doc/src/Makefile
+++ b/lib/hipe/doc/src/Makefile
@@ -94,6 +94,7 @@ debug opt:
clean clean_docs:
rm -rf $(HTMLDIR)/*
+ rm -rf $(XMLDIR)
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml
index 9299c6d73f..63bc6ea2d7 100644
--- a/lib/hipe/doc/src/hipe_app.xml
+++ b/lib/hipe/doc/src/hipe_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1997</year><year>2016</year>
+ <year>1997</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -35,6 +35,14 @@
<app>HiPE</app>
<appsummary>The HiPE Application</appsummary>
<description>
+ <note>
+ <p>
+ HiPE and execution of HiPE compiled code only have limited support by
+ the OTP team at Ericsson. The OTP team only does limited maintenance
+ of HiPE and does not actively develop HiPE. HiPE is mainly supported
+ by the HiPE team at Uppsala University.
+ </p>
+ </note>
<p>
The normal way to native-compile an Erlang module using HiPE is to include the atom native
in the Erlang compiler options, as in:</p>
@@ -100,16 +108,74 @@
</item>
<tag>Optimization for <c>receive</c> with unique references</tag>
- <item><p>The BEAM compiler can do an optimization when
- a <c>receive</c> statement is <em>only</em> waiting for messages
- containing a reference created before the receive. All messages
- that existed in the queue when the reference was created will be
- bypassed, as they cannot possibly contain the reference. HiPE
- does not implement this optimization.</p>
- <p>An example of this is when
- <c>gen_server:call()</c> waits for the reply message.</p>
+ <item>
+ <p>
+ The BEAM compiler can do an optimization when a receive
+ statement is only waiting for messages containing a reference
+ created before the receive. All messages that existed in the
+ queue when the reference was created will be bypassed, as they
+ cannot possibly contain the reference. HiPE currently has an
+ optimization similar this, but it is not guaranteed to
+ bypass all messages. In the worst case scenario, it cannot
+ bypass any messages at all.
+ </p>
+ <p>
+ An example of this is when <c>gen_server:call()</c> waits for
+ the reply message.
+ </p>
</item>
+ <tag>Garbage collection after BIFs</tag>
+ <item>
+ <p>
+ The condition for determining whether a garbage collection
+ is needed or not has changed in later releases. HiPE has not
+ been updated regarding this which may cause premature garbage
+ collections after BIF calls.
+ </p>
+ </item>
+
+ </taglist>
+ </section>
+ <section>
+ <title>Stability Issues</title>
+ <taglist>
+ <tag>Not checking reduction count on function returns</tag>
+ <item>
+ <p>
+ BEAM checks the reduction count and schedules out the executing
+ process if needed both when calling a function and when returning
+ from a function call that was not called using a tail call.
+ HiPE only checks the reduction count when calling a function.
+ </p>
+ <p>
+ The runtime system might need to schedule out a process
+ in order to reclaim memory. If the process isn't scheduled
+ out soon after the process has entered this state, memory
+ consumption will quickly grow. Maintaining this state is also
+ quite expensive performance wise.
+ </p>
+ <p>
+ Processes executing code that performs large recursions and
+ produce data after returning from recursive calls may have to
+ be scheduled out when returning from a function call. Since
+ HiPE does not check reductions on returns, processes executing
+ such HiPE compiled code may cause huge peeks in memory
+ consumption as well as severe performance degradation.
+ </p>
+ </item>
+
+ <tag>Not bumping appropriate amount of reductions in <c>receive</c> statements</tag>
+ <item>
+ <p>
+ The process signaling improvements made in ERTS version
+ 10.0 moved potentially significant amounts of work into the
+ receive statement from other places. In order to account for
+ this work, the reduction count should be bumped on the
+ executing process. Reductions are not bumped when entering
+ the <c>receive</c> statement from HiPE compiled code.
+ </p>
+ </item>
</taglist>
</section>
<section>
diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml
index c190a89260..f47868296a 100644
--- a/lib/hipe/doc/src/notes.xml
+++ b/lib/hipe/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2006</year><year>2017</year>
+ <year>2006</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,6 +31,51 @@
</header>
<p>This document describes the changes made to HiPE.</p>
+<section><title>Hipe 3.18</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Optimize <c>receive</c> statements that are only waiting
+ for messages containing a reference created before the
+ receive. All messages that existed in the queue when the
+ reference was created will be bypassed, as they cannot
+ possibly contain the reference. This optimization has
+ existed for vanilla BEAM since OTP R14.</p>
+ <p>
+ Own Id: OTP-14785 Aux Id: PR-1632 </p>
+ </item>
+ <item>
+ <p>
+ Add validation pass to hipe compiler to detect internal
+ errors causing primop calls that may trigger an unsafe GC
+ at run-time. The pass can be disabled with option
+ <c>no_verify_gcsafe</c>.</p>
+ <p>
+ Own Id: OTP-14900 Aux Id: PR-1685, PR-1621 </p>
+ </item>
+ <item>
+ <p>
+ Make hipe compiled code work on x86_64 (amd64) with OS
+ security feature PIE, where executable code can be loaded
+ into a random location. Old behavior, if hipe was
+ enabled, was to disable PIE build options for the VM.</p>
+ <p>
+ Own Id: OTP-14903</p>
+ </item>
+ <item>
+ <p>
+ Inline more type test BIFs; <c>is_number</c>,
+ <c>is_bitstring</c>, <c>is_map</c>.</p>
+ <p>
+ Own Id: OTP-14941 Aux Id: PR-1718 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Hipe 3.17.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 2abecf7f18..f429d40272 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -415,11 +415,13 @@ trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) ->
SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[],
map_label(Lbl),hipe_icode:label_name(DoneLbl)),
Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)];
-%%--- recv_mark/1 & recv_set/1 --- XXX: Handle better??
+%%--- recv_mark/1 & recv_set/1 ---
trans_fun([{recv_mark,{f,_}}|Instructions], Env) ->
- trans_fun(Instructions,Env);
+ Mark = hipe_icode:mk_primop([],recv_mark,[]),
+ [Mark | trans_fun(Instructions,Env)];
trans_fun([{recv_set,{f,_}}|Instructions], Env) ->
- trans_fun(Instructions,Env);
+ Set = hipe_icode:mk_primop([],recv_set,[]),
+ [Set | trans_fun(Instructions,Env)];
%%--------------------------------------------------------------------
%%--- Translation of arithmetics {bif,ArithOp, ...} ---
%%--------------------------------------------------------------------
@@ -603,6 +605,16 @@ trans_fun([{get_list,List,Head,Tail}|Instructions], Env) ->
?error_msg("hd and tl regs identical in get_list~n",[]),
erlang:error(not_handled)
end;
+%%--- get_hd ---
+trans_fun([{get_hd,List,Head}|Instructions], Env) ->
+ TransList = [trans_arg(List)],
+ I = hipe_icode:mk_primop([mk_var(Head)],unsafe_hd,TransList),
+ [I | trans_fun(Instructions,Env)];
+%%--- get_tl ---
+trans_fun([{get_tl,List,Tail}|Instructions], Env) ->
+ TransList = [trans_arg(List)],
+ I = hipe_icode:mk_primop([mk_var(Tail)],unsafe_tl,TransList),
+ [I | trans_fun(Instructions,Env)];
%%--- get_tuple_element ---
trans_fun([{get_tuple_element,Xreg,Index,Dst}|Instructions], Env) ->
I = hipe_icode:mk_primop([mk_var(Dst)],
@@ -794,7 +806,7 @@ trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}|
SizeArg = trans_arg(Size),
BinArg = trans_arg(Binary),
IcodeDst = mk_var(Dst),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg],
[IcodeDst,Base,Offset],
@@ -805,7 +817,7 @@ trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}|
SizeArg = trans_arg(Size),
BinArg = trans_arg(Binary),
IcodeDst = mk_var(Dst),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}},
Lbl,[SizeArg,BinArg],
@@ -844,7 +856,7 @@ 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),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
{Name, Args} =
case Size of
@@ -860,7 +872,7 @@ 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),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
{Name, Args} =
case Size of
@@ -1157,6 +1169,17 @@ trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -
gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1)
end,
[MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--- build_stacktrace ---
+trans_fun([build_stacktrace|Instructions], Env) ->
+ Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
+ [hipe_icode:mk_primop(Vars,build_stacktrace,Vars),
+ trans_fun(Instructions, Env)];
+%%--- raw_raise ---
+trans_fun([raw_raise|Instructions], Env) ->
+ Vars = [mk_var({x,0}),mk_var({x,1}),mk_var({x,2})],
+ Dst = [mk_var({x,0})],
+ [hipe_icode:mk_primop(Dst,raw_raise,Vars) |
+ trans_fun(Instructions, Env)];
%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
@@ -1505,7 +1528,10 @@ clone_dst(Dest) ->
New =
case hipe_icode:is_reg(Dest) of
true ->
- mk_var(reg);
+ case hipe_icode:reg_is_gcsafe(Dest) of
+ true -> mk_var(reg_gcsafe);
+ false -> mk_var(reg)
+ end;
false ->
true = hipe_icode:is_var(Dest),
mk_var(new)
@@ -2126,7 +2152,12 @@ mk_var(reg) ->
T = hipe_gensym:new_var(icode),
V = (5*T)+4,
hipe_gensym:update_vrange(icode,V),
- hipe_icode:mk_reg(V).
+ hipe_icode:mk_reg(V);
+mk_var(reg_gcsafe) ->
+ T = hipe_gensym:new_var(icode),
+ V = (5*T)+4, % same namespace as 'reg'
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_reg_gcsafe(V).
%%-----------------------------------------------------------------------
%% Make an icode label of proper type
@@ -2296,6 +2327,12 @@ split_code([First|Code], Label, Instr) ->
split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label ->
split_code_final(Code, As); % drop both label and instruction
+split_code([{icode_end_try}|_]=Code, Label, {try_case,_}, Prev, As)
+ when Prev =:= Label ->
+ %% The try_case has been replaced with try_end as an optimization.
+ %% Keep this instruction, since it might be the only try_end instruction
+ %% for this try/catch block.
+ split_code_final(Code, As); % drop label
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) ->
diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl
index 24b7ac4783..bc3403b0c5 100644
--- a/lib/hipe/icode/hipe_icode.erl
+++ b/lib/hipe/icode/hipe_icode.erl
@@ -515,10 +515,12 @@
annotate_variable/2, %% annotate_var_or_reg(VarOrReg, Type)
unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg)
mk_reg/1, %% mk_reg(Id)
+ mk_reg_gcsafe/1, %% mk_reg_gcsafe(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_new_reg_gcsafe/0, %% mk_new_reg_gcsafe()
mk_phi/1, %% mk_phi(Id)
mk_phi/2 %% mk_phi(Id, ArgList)
]).
@@ -1260,14 +1262,22 @@ 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 mk_reg_gcsafe(non_neg_integer()) -> #icode_variable{kind::'reg_gcsafe'}.
+mk_reg_gcsafe(V) -> #icode_variable{name=V, kind=reg_gcsafe}.
--spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'.
-reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now
+-spec reg_name(#icode_variable{kind::'reg'|'reg_gcsafe'})
+ -> non_neg_integer().
+reg_name(#icode_variable{name=Name, kind=reg}) -> Name;
+reg_name(#icode_variable{name=Name, kind=reg_gcsafe}) -> Name.
+
+-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false';
+ (#icode_variable{kind::'reg_gcsafe'}) -> 'true'.
+reg_is_gcsafe(#icode_variable{kind=reg}) -> false;
+reg_is_gcsafe(#icode_variable{kind=reg_gcsafe}) -> true.
-spec is_reg(icode_argument()) -> boolean().
-is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(#icode_variable{kind=reg_gcsafe}) -> true;
is_reg(_) -> false.
-spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}.
@@ -1676,6 +1686,16 @@ mk_new_reg() ->
mk_reg(hipe_gensym:get_next_var(icode)).
%%
+%% @doc Makes a new gcsafe register; that is, a register that is allowed to be
+%% live over calls and other operations that might cause GCs and thus move heap
+%% data around.
+%%
+
+-spec mk_new_reg_gcsafe() -> icode_reg().
+mk_new_reg_gcsafe() ->
+ mk_reg_gcsafe(hipe_gensym:get_next_var(icode)).
+
+%%
%% @doc Makes a new label.
%%
diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl
index 380ddd8371..7ed80a9ed4 100644
--- a/lib/hipe/icode/hipe_icode.hrl
+++ b/lib/hipe/icode/hipe_icode.hrl
@@ -41,9 +41,9 @@
-type variable_annotation() :: {atom(), any(), fun((any()) -> string())}.
--record(icode_variable, {name :: non_neg_integer(),
- kind :: 'var' | 'reg' | 'fvar',
- annotation = [] :: [] | variable_annotation()}).
+-record(icode_variable, {name :: non_neg_integer(),
+ kind :: 'var' | 'reg' | 'reg_gcsafe' | 'fvar',
+ annotation = [] :: [] | variable_annotation()}).
%%---------------------------------------------------------------------
%% Type declarations for Icode instructions
@@ -66,7 +66,7 @@
-type icode_funcall() :: mfa() | icode_primop().
-type icode_var() :: #icode_variable{kind::'var'}.
--type icode_reg() :: #icode_variable{kind::'reg'}.
+-type icode_reg() :: #icode_variable{kind::'reg'|'reg_gcsafe'}.
-type icode_fvar() :: #icode_variable{kind::'fvar'}.
-type icode_argument() :: #icode_const{} | #icode_variable{}.
-type icode_term_arg() :: icode_var() | #icode_const{}.
diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl
index 7a6947f190..16a95991e7 100644
--- a/lib/hipe/icode/hipe_icode_inline_bifs.erl
+++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl
@@ -24,8 +24,9 @@
%% Currently inlined BIFs:
%% and, or, xor, not, <, >, >=, =<, ==, /=, =/=, =:=
-%% is_atom, is_boolean, is_binary, is_float, is_function,
-%% is_integer, is_list, is_pid, is_port, is_reference, is_tuple
+%% is_atom, is_binary, is_bitstring, is_boolean, is_float,
+%% is_function, is_integer, is_list, is_map, is_number,
+%% is_pid, is_port, is_reference, is_tuple
-module(hipe_icode_inline_bifs).
@@ -116,17 +117,20 @@ try_type_tests(I) -> I.
is_type_test(Name) ->
case Name of
- is_integer -> {true, integer};
+ is_atom -> {true, atom};
+ is_binary -> {true, binary};
+ is_bitstring -> {true, bitstr};
+ is_boolean -> {true, boolean};
is_float -> {true, float};
- is_tuple -> {true, tuple};
- is_binary -> {true, binary};
+ is_function -> {true, function};
+ is_integer -> {true, integer};
is_list -> {true, list};
+ is_map -> {true, map};
+ is_number -> {true, number};
is_pid -> {true, pid};
- is_atom -> {true, atom};
- is_boolean -> {true, boolean};
- is_function -> {true, function};
- is_reference -> {true, reference};
is_port -> {true, port};
+ is_reference -> {true, reference};
+ is_tuple -> {true, tuple};
_ -> false
end.
diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl
index 51e2855108..e61529a1bb 100644
--- a/lib/hipe/icode/hipe_icode_liveness.erl
+++ b/lib/hipe/icode/hipe_icode_liveness.erl
@@ -77,6 +77,7 @@ 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]);
+ reg_gcsafe -> io:format("rs~p", [V]);
fvar -> io:format("fv~p", [V])
end,
case T of
diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl
index 5b017dca32..33d1e62884 100644
--- a/lib/hipe/icode/hipe_icode_pp.erl
+++ b/lib/hipe/icode/hipe_icode_pp.erl
@@ -230,7 +230,10 @@ pp_arg(Dev, Arg) ->
case hipe_icode:is_reg(Arg) of
true ->
N = hipe_icode:reg_name(Arg),
- io:format(Dev, "r~p", [N]);
+ case hipe_icode:reg_is_gcsafe(Arg) of
+ true -> io:format(Dev, "rs~p", [N]);
+ false -> io:format(Dev, "r~p", [N])
+ end;
false ->
N = hipe_icode:fvar_name(Arg),
io:format(Dev, "fv~p", [N])
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index 50ece05259..a1f1128124 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -67,6 +67,8 @@ is_safe(fp_mul) -> false;
is_safe(fp_sub) -> false;
is_safe(mktuple) -> true;
is_safe(next_msg) -> false;
+is_safe(recv_mark) -> false;
+is_safe(recv_set) -> false;
is_safe(redtest) -> false;
is_safe(select_msg) -> false;
is_safe(self) -> true;
@@ -130,6 +132,7 @@ 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(build_stacktrace) -> true;
is_safe(#mkfun{}) -> true;
is_safe(#unsafe_element{}) -> true;
is_safe(#unsafe_update_element{}) -> true;
@@ -165,6 +168,8 @@ fails(fp_mul) -> false;
fails(fp_sub) -> false;
fails(mktuple) -> false;
fails(next_msg) -> false;
+fails(recv_mark) -> false;
+fails(recv_set) -> false;
fails(redtest) -> false;
fails(select_msg) -> false;
fails(self) -> false;
@@ -230,6 +235,8 @@ 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(build_stacktrace) -> false;
+fails(raw_raise) -> true;
fails(#mkfun{}) -> false;
fails(#unsafe_element{}) -> false;
fails(#unsafe_update_element{}) -> false;
@@ -709,6 +716,10 @@ type(Primop, Args) ->
erl_types:t_any();
next_msg ->
erl_types:t_any();
+ recv_mark ->
+ erl_types:t_any();
+ recv_set ->
+ erl_types:t_any();
select_msg ->
erl_types:t_any();
set_timeout ->
@@ -723,6 +734,10 @@ type(Primop, Args) ->
erl_types:t_any();
debug_native_called ->
erl_types:t_any();
+ build_stacktrace ->
+ erl_types:t_list();
+ raw_raise ->
+ erl_types:t_atom();
{M, F, A} ->
erl_bif_types:type(M, F, A, Args)
end.
@@ -883,6 +898,10 @@ type(Primop) ->
erl_types:t_any();
next_msg ->
erl_types:t_any();
+ recv_mark ->
+ erl_types:t_any();
+ recv_set ->
+ erl_types:t_any();
select_msg ->
erl_types:t_any();
set_timeout ->
@@ -891,6 +910,10 @@ type(Primop) ->
erl_types:t_any();
%%% -----------------------------------------------------
%%% Other
+ build_stacktrace ->
+ erl_types:t_any();
+ raw_raise ->
+ erl_types:t_any();
#closure_element{} ->
erl_types:t_any();
redtest ->
diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl
index 287b1c80fe..34b18acccd 100644
--- a/lib/hipe/icode/hipe_icode_range.erl
+++ b/lib/hipe/icode/hipe_icode_range.erl
@@ -1160,6 +1160,8 @@ basic_type(#gc_test{}) -> not_analysed;
%% Message handling
basic_type(check_get_msg) -> not_analysed;
basic_type(next_msg) -> not_analysed;
+basic_type(recv_mark) -> not_analysed;
+basic_type(recv_set) -> not_analysed;
basic_type(select_msg) -> not_analysed;
basic_type(suspend_msg) -> not_analysed;
%% Functions
@@ -1184,7 +1186,9 @@ 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.
+basic_type(#unsafe_update_element{}) -> not_analysed;
+basic_type(build_stacktrace) -> not_int;
+basic_type(raw_raise) -> not_int.
-spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple().
diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl
index e04b171194..343ca94cb1 100644
--- a/lib/hipe/llvm/hipe_llvm.erl
+++ b/lib/hipe/llvm/hipe_llvm.erl
@@ -1005,11 +1005,12 @@ pp_ins(Dev, Ver, I) ->
write(Dev, [" ", adj_stack_offset(I),")\n"]);
#llvm_meta{} ->
write(Dev, ["!", meta_id(I), " = !{ "]),
- write(Dev, string:join([if is_list(Op) -> ["!\"", Op, "\""];
- is_integer(Op) -> ["i32 ", integer_to_list(Op)];
- is_record(Op, llvm_meta) ->
- ["!", meta_id(Op)]
- end || Op <- meta_operands(I)], ", ")),
+ write(Dev, lists:join(", ",
+ [if is_list(Op) -> ["!\"", Op, "\""];
+ is_integer(Op) -> ["i32 ", integer_to_list(Op)];
+ is_record(Op, llvm_meta) ->
+ ["!", meta_id(Op)]
+ end || Op <- meta_operands(I)])),
write(Dev, " }\n");
Other ->
exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}})
diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl
index 4eec0c752b..54c435c127 100644
--- a/lib/hipe/llvm/hipe_llvm_main.erl
+++ b/lib/hipe/llvm/hipe_llvm_main.erl
@@ -154,7 +154,7 @@ compiler_target_opt() ->
%% @doc Join options.
fix_opts(Opts) ->
- string:join(Opts, " ").
+ lists:flatten(lists:join(" ", Opts)).
%% @doc Translate optimization-level flag (default is "O2").
trans_optlev_flag(Tool, Options) ->
diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
index 79e1bfd381..934717efc1 100644
--- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl
+++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
@@ -1537,7 +1537,7 @@ declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) ->
LabelList = [mk_jump_label(L) || L <- Labels],
Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end,
List2 = lists:map(Fun1, LabelList),
- List3 = string:join(List2, ",\n"),
+ List3 = lists:flatten(lists:join(",\n", List2)),
List4 = "[\n" ++ List3 ++ "\n]\n",
hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4).
@@ -1553,7 +1553,7 @@ declare_closure_labels(ClosureLabels, Relocs, Fun) ->
Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs),
List2 =
["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList],
- List3 = string:join(List2, ",\n"),
+ List3 = lists:flatten(lists:join(",\n", List2)),
List4 = "[\n" ++ List3 ++ "\n]\n",
NrLabels = length(LabelList),
ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)),
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index eef4b9a34f..4684ab49ea 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,7 +26,6 @@
cerl_closurean,
cerl_hipeify,
cerl_lib,
- cerl_messagean,
cerl_pmatch,
cerl_prettypr,
cerl_to_icode,
@@ -179,6 +178,7 @@
hipe_rtl_to_sparc,
hipe_rtl_to_x86,
hipe_rtl_varmap,
+ hipe_rtl_verify_gcsafe,
hipe_segment_trees,
hipe_sdi,
hipe_sparc,
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 19b4e8bfe2..ac2e6c1e3b 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -669,8 +669,8 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) ->
{Icode, WholeModule} = IcodeFun(Code, Opts),
CompRes = compile_finish(Icode, WholeModule, Opts),
compiler_return(CompRes, Parent)
- catch error:Error ->
- print_crash_message(Name, Error),
+ catch error:Error:StackTrace ->
+ print_crash_message(Name, Error, StackTrace),
exit(Error)
end
end),
@@ -757,8 +757,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) ->
TargetArch = get(hipe_target_arch),
{ok, {TargetArch,Bin}}
catch
- error:Error ->
- {error,Error,erlang:get_stacktrace()}
+ error:Error:StackTrace ->
+ {error,Error,StackTrace}
end
end.
@@ -843,17 +843,17 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) ->
{llvm_binary, Binary} ->
{MFA, Binary}
catch
- error:Error ->
+ error:Error:StackTrace ->
?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])),
- print_crash_message(MFA, Error),
+ print_crash_message(MFA, Error, StackTrace),
exit(Error)
end.
-print_crash_message(What, Error) ->
+print_crash_message(What, Error, StackTrace) ->
StackFun = fun(_,_,_) -> false end,
FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end,
- StackTrace = lib:format_stacktrace(1, erlang:get_stacktrace(),
- StackFun, FormatFun),
+ StackTraceS = erl_error:format_stacktrace(1, StackTrace,
+ StackFun, FormatFun),
WhatS = case What of
{M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]);
Mod -> io_lib:format("~w", [Mod])
@@ -862,7 +862,7 @@ print_crash_message(What, Error) ->
"while compiling ~s~n"
"crash reason: ~p~n"
"~s~n",
- [WhatS, Error, StackTrace]).
+ [WhatS, Error, StackTraceS]).
pp_server_start(Opts) ->
set_architecture(Opts),
@@ -1414,6 +1414,7 @@ opt_keys() ->
use_clusters,
use_jumptable,
verbose,
+ verify_gcsafe,
%% verbose_spills,
x87].
@@ -1510,7 +1511,8 @@ opt_negations() ->
{no_use_callgraph, use_callgraph},
{no_use_clusters, use_clusters},
{no_use_inline_atom_search, use_inline_atom_search},
- {no_use_indexing, use_indexing}].
+ {no_use_indexing, use_indexing},
+ {no_verify_gcsafe, verify_gcsafe}].
%% Don't use negative forms in right-hand sides of aliases and expansions!
%% We only expand negations once, before the other expansions are done.
@@ -1616,11 +1618,11 @@ llvm_support_available() ->
get_llvm_version() ->
OptStr = os:cmd("opt -version"),
SubStr = "LLVM version ", N = length(SubStr),
- case string:str(OptStr, SubStr) of
- 0 -> % No opt available
+ case string:find(OptStr, SubStr) of
+ nomatch -> % No opt available
{0, 0};
S ->
- case string:tokens(string:sub_string(OptStr, S + N), ".") of
+ case string:lexemes(string:slice(S, N), ".") of
[MajorS, MinorS | _] ->
case {string:to_integer(MajorS), string:to_integer(MinorS)} of
{{Major, ""}, {Minor, _}}
diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl
index dca6fddec3..6e48f0cffd 100644
--- a/lib/hipe/main/hipe_main.erl
+++ b/lib/hipe/main/hipe_main.erl
@@ -410,6 +410,11 @@ icode_to_rtl(MFA, Icode, Options, Servers) ->
hipe_llvm_liveness:analyze(RtlCfg4)
end,
pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers),
+ case proplists:get_bool(no_verify_gcsafe, Options) of
+ true -> ok;
+ false ->
+ ok = hipe_rtl_verify_gcsafe:check(RtlCfg5)
+ end,
LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5),
LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1),
%% hipe_rtl:pp(standard_io, LinearRTL2),
diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl
deleted file mode 100644
index 0f25940e3d..0000000000
--- a/lib/hipe/opt/hipe_schedule.erl
+++ /dev/null
@@ -1,1483 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INSTRUCTION SCHEDULER
-%%
-%% This is a basic ILP cycle scheduler:
-%% * set cycle = 0
-%% * while ready[cycle] nonempty do
-%% - take x with greatest priority from ready[cycle]
-%% - try to schedule x;
-%% * if scheduling x was possible,
-%% - reserve resources
-%% - add x to schedule and delete x from dag
-%% - update earliest-time for all successor nodes
-%% as max[earliest[y],cycle+latency[x]]
-%% - if some node y now has no predecessors,
-%% add y to ready[earliest[y]]
-%% * if it was impossible, put x in ready[cycle+1]
-%% (= try again)
-%%
-%% We use the following data structures:
-%% 1. all nodes are numbered and indices used as array keys
-%% 2. priority per node can be computed statically or dynamically
-%% * statically: before scheduling, each node gets a priority value
-%% * dynamically: at each cycle, compute priorities for all ready nodes
-%% 3. earliest: earliest cycle of issue, starts at 0
-%% and is updated as predecessors issue
-%% 4. predecessors: number of predecessors (0 = ready to issue)
-%% 5. successors: list of {Latency,NodeID}
-%% 6. ready: an array indexed by cycle-time (integer), where
-%% ready nodes are kept.
-%% 7. resources: a resource representation (ADT) that answers
-%% certain queries, e.g., "can x be scheduled this cycle"
-%% and "reserve resources for x".
-%% 8. schedule: list of scheduled instructions {Instr,Cycle}
-%% in the order of issue
-%% 9. instructions: maps IDs back to instructions
-%%
-%% Inputs:
-%% - a list of {ID,Node} pairs (where ID is a unique key)
-%% - a dependence list {ID0,Latency,ID1}, which is used to
-%% build the DAG.
-%%
-%% Note that there is some leeway in how things are represented
-%% from here.
-%%
-%% MODIFICATIONS:
-%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code)
-%% yet are pretty voluminous. How do we skip them?
-%% - Scheduling should be done at finalization time: when basic block is
-%% linearized and is definitely at Sparc assembly level, THEN reorder
-%% stuff.
-
--module(hipe_schedule).
--export([cfg/1, est_cfg/1, delete_node/5]).
-
--include("../sparc/hipe_sparc.hrl").
-
-%%-define(debug1,true).
-
--define(debug2(Str,Args),ok).
-%%-define(debug2(Str,Args),io:format(Str,Args)).
-
--define(debug3(Str,Args),ok).
-%%-define(debug3(Str,Args),io:format(Str,Args)).
-
--define(debug4(Str,Args),ok).
-%%-define(debug4(Str,Args),io:format(Str,Args)).
-
--define(debug5(Str,Args),ok).
-%%-define(debug5(Str,Args),io:format(Str,Args)).
-
--define(debug(Str,Args),ok).
-%%-define(debug(Str,Args),io:format(Str,Args)).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cfg
-%% Argument : CFG - the control flow graph
-%% Returns : CFG - A new cfg with scheduled blocks
-%% Description : Takes each basic block and schedules them one by one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cfg(CFG) ->
- ?debug3("CFG: ~n~p", [CFG]),
- update_all( [ {L,
- hipe_bb:mk_bb(
- block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_all
-%% Argument : Blocks - [{Label, Block}] , a list with labels and new code
-%% used for updating the old CFG.
-%% CFG - The old controlflow graph
-%% Returns : An updated controlflow graph.
-%% Description : Just swappes the basic blocks in the CFG to the scheduled one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_all([],CFG) -> CFG;
-update_all([{L,NewB}|Ls],CFG) ->
- update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-est_cfg(CFG) ->
- update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Provides an estimation of how quickly a block will execute.
-%% This is done by chaining all instructions in sequential order
-%% by 0-cycle dependences (which means they will never be reordered),
-%% then scheduling the mess.
-
-est_block([]) -> [];
-est_block([I]) -> [I];
-est_block(Blk) ->
- {IxBlk,DAG} = est_deps(Blk),
- Sch = bb(IxBlk,DAG),
- separate_block(Sch,IxBlk).
-
-est_deps(Blk) ->
- IxBlk = indexed_bb(Blk),
- DAG = deps(IxBlk),
- {IxBlk, chain_instrs(IxBlk,DAG)}.
-
-chain_instrs([{N,_}|Xs],DAG) ->
- chain_i(N,Xs,DAG).
-
-chain_i(_,[],DAG) -> DAG;
-chain_i(N,[{M,_}|Xs],DAG) ->
- NewDAG = dep_arc(N,zero_latency(),M,DAG),
- chain_i(M,Xs,NewDAG).
-
-zero_latency() -> 0.
-
-lookup_instr([{N,I}|_], N) -> I;
-lookup_instr([_|Xs], N) -> lookup_instr(Xs, N).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : block
-%% Argument : Instrs - [Instr], list of all the instructions in a basic
-%% block.
-%% Returns : A new scheduled block
-%% Description : Schedule a basic block
-%%
-%% Note: does not consider delay slots!
-%% (another argument for using only annulled delay slots?)
-%% * how do we add delay slots? somewhat tricky to
-%% reconcile with the sort of scheduling we consider.
-%% (as-early-as-possible)
-%% => rewrite scheduler into as-late-as-possible?
-%% (=> just reverse the dependence arcs??)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Don't fire up the scheduler if there's no work to do.
-block(_, []) ->
- [];
-block(_L, [I]) ->
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
-block(_L, Blk) ->
- IxBlk = indexed_bb(Blk),
- case IxBlk of
- [{_N, I}] -> % comments and nops may have been removed.
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
- _ ->
- Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)),
- {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG),
- X = finalize_block(NewSch, NewIxBlk),
- debug1_stuff(Blk, DAG, IxBlk, Sch, X),
- X
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_delays
-%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle
-%% N = node index
-%% IxBlk - Indexed block [{N, Instr}]
-%% DAG - Dependence graph
-%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector
-%% with {N, Instr}
-%% Description : Goes through the schedule from back to front looking for
-%% branches/jumps. If one is found fill_del tries to find
-%% an instr to fill the delayslot.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_delays(Sch, IxBlk, DAG) ->
- NewIxBlk = hipe_vectors:list_to_vector(IxBlk),
- %% NewSch = hipe_vectors:list_to_vector(Sch),
- NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch),
- NewIxBlk, DAG),
- {NewSch, NewIxBlk}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_del
-%% Argument : N - current index in the schedule
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - New schedule with possibly a delay instr in the last
-%% position.
-%% Description : If a call/jump is found fill_branch_delay/fill_call_delay
-%% is called to find a delay-filler.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch;
-fill_del(N, Sch, IxBlk, DAG) ->
- Index = get_index(Sch, N),
- ?debug2("Index for ~p: ~p~nInstr: ~p~n",
- [N, Index, get_instr(IxBlk, Index)]),
- NewSch =
- case get_instr(IxBlk, Index) of
- #call_link{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp_link{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #b{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #br{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #goto{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- _Other ->
- Sch
- end,
- NewSch.
- %% fill_del(N - 1, NewSch, IxBlk, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_call_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Call - index in schedule of call
-%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... >
-%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... >
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Call-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_call_delay(Cand, Call, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- CallIndex = get_index(Sch, Call),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, CallIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG);
-
- true ->
- CallI = get_instr(IxBlk, CallIndex),
-
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)),
- CallUses = ordsets:from_list(hipe_sparc:uses(CallI)),
-
- Args = case CallI of
- #jmp_link{} ->
- ordsets:from_list(
- hipe_sparc:jmp_link_args(CallI));
- #jmp{} ->
- ordsets:from_list(hipe_sparc:jmp_args(CallI));
- #call_link{} ->
- ordsets:from_list(
- hipe_sparc:call_link_args(CallI))
- end,
- CallUses2 = ordsets:subtract(CallUses, Args),
- Conflict = ordsets:intersection(CandDefs, CallUses2),
- %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]),
- %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]),
- %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]),
- %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]),
- %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]),
- %% io:format("Conflict = ~p~n",[Conflict]),
-
- case Conflict of
- [] -> % No conflicts ==> Cand can fill delayslot after Call
- update_schedule(Cand, Call, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_branch_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Branch - index in schedule of branch
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Branch-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- BrIndex = get_index(Sch, Br),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, BrIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG);
-
- true ->
- BrI = get_instr(IxBlk, BrIndex),
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)),
- BrUses = ordsets:from_list(hipe_sparc:uses(BrI)),
-
- Conflict = ordsets:intersection(CandDefs, BrUses),
- %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]),
- %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]),
- %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]),
- %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]),
- %% io:format("Conflict = ~p~n",[Conflict]);
-
- case Conflict of
- [] -> % No conflicts ==>
- % Cand can fill delayslot after Branch
- update_schedule(Cand, Br, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_schedule
-%% Argument : From - the position from where to switch indexes in Sch
-%% To - the position to where to switch indexes in Sch
-%% Sch - schedule
-%% Returns : Sch - an updated schedule
-%% Description : If From is the delay-filler and To is the Call/jump, the
-%% schedule is updated so From gets index To, To gets index
-%% To - 1, and the nodes between From and To gets old_index - 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_schedule(To, To, Sch) ->
- {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1),
- hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node});
-update_schedule(From, To, Sch) ->
- Temp = hipe_vectors:get(Sch, From-1),
- Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)),
- update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : single_depend
-%% Argument : N - Index of the delayslot candidate
-%% M - Index of the node that N possibly has a single
-%% depend to.
-%% DAG - The dependence graph
-%% Returns : true if no other nodes than N os depending on N
-%% Description : Checks that no other nodes than M depends on N and that the
-%% latency between them is zero or 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-single_depend(N, M, DAG) ->
- Deps = hipe_vectors:get(DAG, N-1),
- single_depend(M, Deps).
-
-single_depend(_N, []) -> true;
-single_depend(N, [{0, N}]) -> true;
-single_depend(N, [{1, N}]) -> true;
-single_depend(_N, [{_Lat, _}|_]) -> false.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_index
-%% Argument : Sch - schedule
-%% N - index in schedule
-%% Returns : Index - index of the node
-%% Description : Returns the index of the node on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_index(Sch, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1),
- Index.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : IxBlk - indexed block
-%% N - index in block
-%% Returns : Instr
-%% Description : Returns the instr on position N in the indexed block.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(IxBlk, N) ->
- {_, Instr} = hipe_vectors:get(IxBlk, N-1),
- Instr.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : Sch - schedule
-%% IxBlk - indexed block
-%% N - index in schedule
-%% Returns : Instr
-%% Description : Returns the instr on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(Sch, IxBlk, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1),
- {_, Instr} = hipe_vectors:get(IxBlk, Index-1),
- Instr.
-
-separate_block(Sch,IxBlk) ->
- sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]).
-
-sep_comments([]) -> [];
-sep_comments([{C,I}|Xs]) ->
- [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)].
-
-sep_comments([], _) -> [];
-sep_comments([{C1,I}|Xs], C0) ->
- if
- C1 > C0 ->
- [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)];
- true ->
- [I|sep_comments(Xs, C0)]
- end.
-
-finalize_block(Sch, IxBlk) ->
- ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]),
- finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []).
-
-finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 ->
- NextLast = get_instr(Sch, IxBlk, N),
- Last = get_instr(Sch, IxBlk, End),
- ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]),
- case hipe_sparc:is_any_branch(Last) of
- true -> % Couldn't fill delayslot ==> add NOP
- [NextLast , hipe_sparc:nop_create(), Last];
- false -> % Last is a delayslot-filler ==> change order...
- [Last, NextLast]
- end;
-finalize_block(N, End, C0, Sch, IxBlk, Instrs) ->
- {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1),
- Instr = get_instr(Sch, IxBlk, N),
- ?debug5("Instr: ~p~n~n",[Instr]),
- [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : bb
-%% Argument : IxBlk - indexed block
-%% DAG - {Dag, Preds} where Dag is dependence graph and
-%% Preds is number of predecessors for each node.
-%% Returns : Sch
-%% Description : Initializes earliest-list, ready-list, priorities, resources
-%% and so on, and calls the cycle_sched which does the scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-bb(IxBlk,DAG) ->
- bb(length(IxBlk), IxBlk, DAG).
-
-bb(N,IxBlk,{DAG, Preds}) ->
- Earliest = init_earliest(N),
- BigArray = N*10, % "nothing" is this big :-)
- Ready = hipe_schedule_prio:init_ready(BigArray,Preds),
- I_res = init_instr_resources(N, IxBlk),
-
- Prio = hipe_schedule_prio:init_instr_prio(N,DAG),
- Rsrc = init_resources(BigArray),
- ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]),
- ?debug('cycle 1~n',[]),
- Sch = empty_schedule(),
- cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cycle_sched
-%% Argument : - C is current cycle, 1 or more.
-%% - Ready is an array (Cycle -> [Node])
-%% yielding the collection of nodes ready to be
-%% scheduled in a cycle.
-%% - DAG is an array (Instr -> [{Latency,Instr}])
-%% represents the dependence DAG.
-%% - Preds is an array (Instr -> NumPreds)
-%% counts the number of predecessors
-%% (0 preds = ready to be scheduled).
-%% - Earl is an array (Instr -> EarliestCycle)
-%% holds the earliest cycle an instruction can be scheduled.
-%% - Rsrc is a 'resource ADT' that handles scheduler resource
-%% management checks whether instruction can be scheduled
-%% this cycle without a stall.
-%% - I_res is an array (Instr -> Required_resources)
-%% holds the resources required to schedule an instruction.
-%% - Sch is the representation of the schedule current schedule.
-%% - N is the number of nodes remaining to be scheduled
-%% tells us when to stop the scheduler.
-%% - IxBlk is the indexed block with instrs
-%% Returns : present schedule
-%% Description : Scheduler main loop.
-%% Pick next ready node in priority order for cycle C until
-%% none remain.
-%% * check each node if it can be scheduled w/o stalling
-%% * if so, schedule it
-%% * otherwise, bump the node to the next cycle
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) ->
- case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of
-% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of
- {next,I,Ready1} ->
- ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]),
- case resources_available(C,I,Rsrc,I_res) of
- {yes,NewRsrc} ->
- ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]),
- NewSch = add_to_schedule(I,C,Sch),
- {ReadyNs,NewDAG,NewPreds,NewEarl} =
- delete_node(C,I,DAG,Preds,Earl),
- ?debug("NewPreds : ~p~n",[Preds]),
- ?debug(' ReadyNs: ~p~n',[ReadyNs]),
- NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs,
- Ready1),
- ?debug(' New ready: ~p~n',[NewReady]),
- cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl,
- NewRsrc,I_res,Prio,NewSch,N-1, IxBlk);
- no ->
- ?debug(' resource conflict~n',[]),
- NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1),
- cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc,
- I_res,Prio,Sch,N,IxBlk)
- end;
- none -> % schedule next cycle if some node remains
- if
- N > 0 ->
- ?debug('cycle ~p~n',[C+1]),
- cycle_sched(C+1,Ready,DAG,Preds,Earl,
- advance_cycle(Rsrc),
- I_res,Prio,Sch,N, IxBlk);
- true ->
- present_schedule(Sch)
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_earliest
-%% Argument : N - number of instrs
-%% Returns :
-%% Description :
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_earliest(N) ->
- hipe_vectors:new(N,1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Schedule is kept reversed until the end.
-
--define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_schedule
-%% Description : Returns an empty schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_schedule() -> [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_to_schedule
-%% Argument : I - instr
-%% Cycle - cycle when I was placed
-%% Sch - schedule
-%% Description : Adds instr to schedule
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_to_schedule(I,Cycle,Sch) ->
- [?present_node(I,Cycle)|Sch].
-
-present_schedule(Sch) -> lists:reverse(Sch).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Interface to resource manager:
-%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_resources
-%% Description : Yields a 'big enough' array mapping (Cycle -> Resources);
-%% this array is called Rsrc below.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_resources(S) ->
- hipe_target_machine:init_resources(S).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_instr_resources
-%% Argument : Nodes - a list of the instructions
-%% N - is the number of nodes
-%% Description : return a vector (NodeID -> Resource_requirements)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_instr_resources(N,Nodes) ->
- hipe_target_machine:init_instr_resources(N,Nodes).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : resources_available
-%% Argument : Cycle - the current cycle
-%% I - the current instruction (index = NodeID)
-%% Rsrc - a map (Cycle -> Resources)
-%% I_res - maps (NodeID -> Resource_requirements)
-%% Description : returns {yes,NewResTab} | no
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-resources_available(Cycle,I,Rsrc,I_res) ->
- hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : advance_cycle
-%% Argument : Rsrc - resources
-%% Description : Returns an empty resources-state
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-advance_cycle(Rsrc) ->
- hipe_target_machine:advance_cycle(Rsrc).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : delete_node
-%% Argument : Cycle - current cycle
-%% I - index of instr
-%% DAG - dependence dag
-%% Preds - array with number of predecessors for nodes
-%% Earl - array with earliest-times for nodes
-%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl}
-%% Description : Deletes node I and updates earliest times for the rest.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-delete_node(Cycle,I,DAG,Preds,Earl) ->
- Succ = hipe_vectors:get(DAG,I-1),
- NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support'
- {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]),
- ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]),
- {ReadyNs,NewDAG,NewPreds,NewEarl}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_earliest
-%% Argument : Succ - successor list
-%% Cycle - current cycle
-%% Preds - predecessors
-%% Earl - earliest times for nodes
-%% Ready - array with readynodes for cycles
-%% Returns : {Ready,Preds,Earl}
-%% Description : Updates the earliest times for nodes and updates number of
-%% predecessors for nodes
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_earliest([],_Cycle,Preds,Earl,Ready) ->
- {Ready,Preds,Earl};
-update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) ->
- Old_earl = hipe_vectors:get(Earl,N-1),
- New_earl = erlang:max(Old_earl,Cycle+Lat),
- NewEarl = hipe_vectors:set(Earl,N-1,New_earl),
- Num_preds = hipe_vectors:get(Preds,N-1),
- NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1),
- if
- Num_preds =:= 0 ->
- ?debug('inconsistent DAG~n',[]),
- exit({update_earliest,N});
- Num_preds =:= 1 ->
- NewReady = [{New_earl,N}|Ready],
- NewPreds2 = hipe_vectors:set(NewPreds,N-1,0),
- update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady);
- is_integer(Num_preds), Num_preds > 1 ->
- update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%% returns { [{Index,Instr}], DepDAG }
-%% DepDAG is defined below.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps
-%% Argument : BB - Basic block
-%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists
-%% of both Dag and Preds, where Preds is number
-%% of predecessors for nodes.
-%% Description : Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps(IxBB) ->
- N = length(IxBB),
- DAG = empty_dag(N), % The DAG contains both dependence-arcs and
- % number of predeccessors...
- {_DepTab,DAG1} = dd(IxBB, DAG),
- DAG2 = md(IxBB, DAG1),
- cd(IxBB, DAG2).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_dag
-%% Argument : N - number of nodes
-%% Returns : empty DAG
-%% Description : DAG consists of dependence graph and predeccessors
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_dag(N) ->
- {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : indexed_bb
-%% Argument : BB - basic block
-%% Returns : [{N, Instr}]
-%% Description : Puts indexes to all instrs of a block, removes comments.
-%% NOP's are also removed because if both sparc_schedule and
-%% sparc_post_schedule options are used, the first pass will
-%% add nop's before the branch if necessary, and these are
-%% removed before scheduling the second pass.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-indexed_bb(BB) ->
- indexed_bb(BB,1).
-
-indexed_bb([],_N) -> [];
-indexed_bb([X|Xs],N) ->
- case X of
- #comment{} ->
- indexed_bb(Xs,N);
- #nop{} ->
- indexed_bb(Xs,N);
- _Other ->
- [{N,X}|indexed_bb(Xs,N+1)]
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : dep_arc
-%% Argument : N - Current node
-%% Lat - Latency from current node to M
-%% M - The dependent node
-%% DAG - The dependence graph. Consists of both DAG and
-%% predeccessors
-%% Returns : A new DAG with the arc added and number of predeccessors for
-%% M increased.
-%% Description : Adds a new arc to the graph, if an older arc goes from N to M
-%% it will be replaced with a new arc {max(OldLat, NewLat), M}.
-%% Number of predeccessors for node M is increased.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dep_arc(N, Lat, M, {Dag,Preds}) ->
- OldDeps = hipe_vectors:get(Dag, N-1),
- %% io:format("{OldDeps} = {~p}~n",[OldDeps]),
- {NewDeps, Status} = add_arc(Lat, M, OldDeps),
- %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]),
- NewDag = hipe_vectors:set(Dag, N-1, NewDeps),
- NewPreds = case Status of
- added -> % just increase preds if new arc was added
- OldPreds = hipe_vectors:get(Preds, M-1),
- hipe_vectors:set(Preds, M-1, OldPreds + 1);
- non_added ->
- Preds
- end,
- {NewDag, NewPreds}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_arc
-%% Argument : Lat - The latency from current node to To.
-%% To - The instr-id of the node which the dependence goes to
-%% Arcs - The dependecies that are already in the dep-graph
-%% Returns : A dependence graph sorted by To.
-%% Description : A new arc that is added is sorted in the right place, and if
-%% there is already an arc between nodes A and B, the one with
-%% the greatest latency is chosen.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_arc(Lat,To, []) -> {[{Lat, To}], added};
-add_arc(Lat1, To, [{Lat2, To} | Arcs]) ->
- {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added};
-add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 ->
- {[{Lat1, To1}, {Lat2, To2} | Arcs], added};
-add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) ->
- {Arcs1, Status} = add_arc(Lat1, To1, Arcs),
- {[{Lat2, To2} | Arcs1], Status}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The register/data dependence DAG of a block is represented
-%% as a mapping (Variable -> {NextWriter,NextReaders})
-%% where NextWriter is a pair {Ix,Type}
-%% and NextReaders is a list of pairs {Ix,Type}.
-%%
-%% Type is used to determine latencies of operations; on the UltraSparc,
-%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if
-%% n is an integer op and m is a store, then latency is 0; if m is an
-%% integer op, it's 1.)
-
-dd([],DAG) -> { empty_deptab(), DAG };
-dd([{N,I}|Is],DAG0) ->
- {DepTab,DAG1} = dd(Is,DAG0),
- add_deps(N,I,DepTab,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_deps
-%% Argument : N - current node
-%% Instr - current instr
-%% DepTab - hashtable with {next-writer, next-readers} for reg
-%% DAG - dependence graph
-%% Returns : {DepTab, BlockInfo, DAG} - with new values
-%% Description : Adds dependencies for node N to the graph. The registers that
-%% node N defines and uses are used for computing the
-%% dependencies to the following nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_deps(N,Instr,DepTab,DAG) ->
- {Ds,Us} = def_use(Instr),
- Type = dd_type(Instr),
- {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG),
- add_read_deps(Us,N,Type,DepTab1,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Instructions are classified into symbolic categories,
-%% which are subsequently used to determine operation latencies
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dd_type(Instr) ->
- case Instr of
- #b{} -> branch;
- %% #br{} -> branch;
- #call_link{} -> branch;
- #jmp_link{} -> branch;
- #jmp{} -> branch;
- #goto{} -> branch;
- #load{} -> load;
- #store{} -> store;
- #alu{} -> alu;
- #move{} -> alu;
- #multimove{} ->
- Src = hipe_sparc:multimove_src(Instr),
- Lat = round(length(Src)/2),
- {mmove,Lat};
- #sethi{} -> alu;
- #alu_cc{} -> alu_cc;
- %% #cmov_cc{} -> cmov_cc;
- %% #cmov_r{} -> alu;
- #load_atom{} -> alu;
- #load_address{} -> alu;
- #pseudo_enter{} -> pseudo;
- #pseudo_pop{} -> pseudo;
- #pseudo_return{} -> pseudo;
- #pseudo_spill{} -> pseudo;
- #pseudo_unspill{} -> pseudo
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_deps
-%% Argument : Defs - registers that node N defines.
-%% N - current node
-%% Ty - the type of current instr
-%% DepTab - Dependence-table
-%% DAG - The dependence graph.
-%% Returns : {DepTab,DAG} - with new values
-%% Description : Adds dependencies to the graph for nodes that depends on the
-%% registers that N defines.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_write_deps([D|Ds],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG),
- add_write_deps(Ds,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_dep
-%% Description : Updates the dependence table with N as next writer, and
-%% updates the DAG with the dependencies from N to subsequent
-%% nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,NxtReaders} = lookup(X,DepTab),
- NewDepTab = writer(X,N,Ty,DepTab),
- NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG),
- {NewDepTab, NewDAG}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : write_deps
-%% Argument : Instr - Current instr
-%% Ty - Type of current instr
-%% NxtWriter - The node that is the next writer of the ragister
-%% that Instr defines.
-%% NxtReaders - The nodes that are subsequent readers of the
-%% register that N defines.
-%% DAG - The dependence graph
-%% Returns : Calls raw_deps that finally returns a new DAG with the new
-%% dependence arcs added.
-%% Description : If a next writer exists a dependence arc for this node is
-%% added, and after this raw_deps is called to compute the
-%% arcs for read-after-write dependencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) ->
- DAG1 = case NxtWriter of
- none ->
- DAG;
- {Instr,_} ->
- DAG;
- {Wr,WrTy} ->
- dep_arc(Instr,
- hipe_target_machine:waw_latency(Ty,WrTy),
- Wr, DAG)
- end,
- raw_deps(Instr,Ty,NxtReaders,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : raw_deps
-%% Argument : Instr - current instr
-%% Type - type of instr
-%% Readers - subsequent readers
-%% DAG - dependence graph
-%% Returns : DAG - A new DAG with read-after-write dependencies added
-%% Description : Updates the DAG with the dependence-arcs from Instr to the
-%% subsequent readers, with the appropriate latencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-raw_deps(_Instr,_Type,[],DAG) -> DAG;
-raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) ->
- raw_deps(Instr,Ty,Xs,
- dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy),
- Rd,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_deps
-%% Argument : Uses - The registers that node N uses.
-%% N - Index of the current node.
-%% Ty - Type of current node.
-%% DepTab - Dependence table
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values.
-%% Description : Adds the read dependencies from node N to subsequent ones,
-%% according to the registers that N uses.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_read_deps([U|Us],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG),
- add_read_deps(Us,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_dep
-%% Argument : X - Used register
-%% N - Index of checked instr
-%% Ty - Type of checked instr
-%% DepTab - Hashtable with {next-writer, next-readers}
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values
-%% Description : Looks up what the next-writer/next-readers are, and adjusts
-%% the table with current node as new reader. Finally
-%% read-dependencies are added to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,_NxtReaders} = lookup(X,DepTab),
- NewDepTab = reader(X,N,Ty,DepTab),
- NewDAG = read_deps(N,Ty,NxtWriter,DAG),
- {NewDepTab, NewDAG}.
-
-% If NxtWriter is 'none', then this var is not written subsequently
-% Add WAR from Instr to NxtWriter (if it exists)
-% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : read_deps
-%% Argument : N - Index of current node
-%% Ty - Type of current node
-%% Writer - tuple {NextWriter, WrType} where NextWriter is the
-%% subsequent instr that writes this register next time,
-%% and WrType is the type of that instr.
-%% DAG - The dependence graph
-%% Returns : DAG
-%% Description : Returns a new DAG if a next-writer exists, otherwise the old
-%% DAG is returned.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-read_deps(_Instr,_Ty,none,DAG) ->
- DAG;
-read_deps(_Instr,_Ty,{_Instr,_},DAG) ->
- DAG;
-read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) ->
- dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr,
- DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_deptab
-%% Description : Creates an empty dependence table (hash-table)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_deptab() ->
- gb_trees:empty().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : lookup
-%% Argument : X - key (register)
-%% DepTab - dependence table
-%% Returns : {NextWriter, NextReaders}
-%% Description : Returns next writer and a list of following readers on
-%% register X.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-lookup(X, DepTab) ->
- case gb_trees:lookup(X, DepTab) of
- none ->
- {none, []};
- {value, {W, Rs} = Val} ->
- Val
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : writer
-%% Argument : X - key (register)
-%% N - index of writer
-%% Ty - type of writer
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Sets N tobe next writer on X
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-writer(X, N, Ty, DepTab) ->
- gb_trees:enter(X, {{N, Ty}, []}, DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : reader
-%% Argument : X - key (register)
-%% N - index of reader
-%% Ty - type of reader
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Adds N to the dependence table as a reader.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-reader(X,N,Ty,DepTab) ->
- {W,Rs} = lookup(X,DepTab),
- gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The following version of md/2 separates heap- and stack operations,
-%% which allows for greater reordering.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds arcs for load/store dependencies to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md(IxBB, DAG) ->
- md(IxBB,empty_md_state(),DAG).
-
-md([],_,DAG) -> DAG;
-md([{N,I}|Is],St,DAG) ->
- case md_type(I) of
- other ->
- md(Is,St,DAG);
- {st,T} ->
- { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St),
- md(Is,NewSt,
- md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG)));
- {ld,T} ->
- { RAW_nodes, NewSt } = ld_overlap(N,T,St),
- md(Is,NewSt,
- md_raw_deps(RAW_nodes,N,DAG))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_war_deps
-%% Argument : WAR_nodes - write-after-read nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-read dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_war_deps([],_,DAG) -> DAG;
-md_war_deps([M|Ms],N,DAG) ->
- md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_waw_deps
-%% Argument : WAW_nodes - write-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_waw_deps([],_,DAG) -> DAG;
-md_waw_deps([M|Ms],N,DAG) ->
- md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_raw_deps
-%% Argument : RAW_nodes - read-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for read-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_raw_deps([],_,DAG) -> DAG;
-md_raw_deps([M|Ms],N,DAG) ->
- md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_md_state
-%% Description : Returns an empty memorydependence state, eg. 4 lists
-%% representing {StackStores, HeapStores, StackLoads, HeapLoads}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_md_state() -> {[], [], [], []}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_type
-%% Argument : I - instr
-%% Description : Maps the instr-type to a simplified type, telling if it's
-%% store/load resp. heap or stack.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_type(I) ->
- case I of
- #load{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Src = hipe_sparc:load_src(I),
- N = hipe_sparc:reg_nr(Src),
- Off = hipe_sparc:load_off(I),
- if
- N =:= Sp -> % operation on stack
- {ld,{sp,Off}};
- true ->
- {ld,{hp,Src,Off}}
- end;
- #store{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Dst = hipe_sparc:store_dest(I),
- N = hipe_sparc:reg_nr(Dst),
- Off = hipe_sparc:store_off(I),
- if
- N =:= Sp ->
- {st,{sp,Off}};
- true ->
- {st,{hp,Dst,Off}}
- end;
- _ ->
- other
- end.
-
-%% Given a memory operation and a 'memory op state',
-%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }.
-%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps.
-%%
-%% NOTES:
-%% Note that Erlang's semantics ("heap stores never overwrite existing data")
-%% means we can be quite free in reordering stores to the heap.
-%% Ld/St to the stack are simply handled by their offsets; since we do not
-%% rename the stack pointer, this is sufficient.
-%% *** We assume all memory ops have uniform size = 4 ***
-%%
-%% NOTES:
-%% The method mentioned above has now been changed because the assumption that
-%% "heap stores never overwrite existing data" caused a bug when the
-%% process-pointer was treated the same way as the heap. We were also told
-%% that the semantics can possibly change in the future, so it would be more
-%% safe to treat the heap store/loads as the stack.
-%% A future improvement can be to do an alias analysis to give more freedom
-%% in reordering stuff...
-%%
-%% Alias state:
-%% { [StackOp], [HeapOp], [StackOp], [HeapOp] }
-%% where StackOp = {InstrID, Offset}
-%% HeapOp = {InstrID, Reg, Offset}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, DepLds, State } -
-%% where DepStrs/DepLds = [NodeId]
-%% and State is the new state
-%% Description : Adds dependencies for overlapping stores.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off),
- {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off),
- {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}};
-st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DstOff = {Dst, Off},
- {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff),
- {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff),
- {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, State }
-%% Description : Adds dependencies for overlapping laods
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = sp_dep_only(St_Sp, Off),
- {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}};
-ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = hp_dep_only(St_Hp, Src, Off),
- {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_sp_dep
-%% Description : Adds dependencies that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_sp_dep(Stores, Off) ->
- sp_dep(Stores, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_sp_dep
-%% Description : Adds dependencies that are depending on a stack load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_sp_dep(Loads, Off) ->
- sp_dep(Loads, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_hp_dep
-%% Description : Adds dependencies that are depending on a heap store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_hp_dep(Stores, {_Reg, _Off} = RegOff) ->
- hp_dep(Stores, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_hp_dep
-%% Description : Adds dependencies that are depending on a heap load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_hp_dep(Loads, {_Reg, _Off} = RegOff) ->
- hp_dep(Loads, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a stack load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep([], _Off, Dep, Indep) -> {Dep, Indep};
-sp_dep([{N,Off}|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, [N|Dep], Indep);
-sp_dep([X|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, Dep, [X|Indep]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : hp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a heap load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep};
-hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off ->
- hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]);
-hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) ->
- hp_dep(Xs, {Reg,Off}, [N|Dep], Indep).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep_only
-%% Description : Returns a list of nodes that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep_only(Stores, Off) ->
- [N || {N,Off0} <- Stores, Off =:= Off0].
-
-%% Dependences from heap stores to heap loads.
-%% *** UNFINISHED ***
-%% - but works
-%% This is somewhat subtle:
-%% - a heap load can only bypass a heap store if we KNOW it won't
-%% load the stored value
-%% - unfortunately, we do not know the relationships between registers
-%% at this point, so we can't say that store(p+4) is independent of
-%% load(q+0).
-%% (OR CAN WE? A bit closer reasoning might show that it's possible?)
-%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c'
-%%
-%% (As said before, it might be possible to lighten this restriction?)
-
-hp_dep_only([], _Reg, _Off) -> [];
-hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off ->
- hp_dep_only(Xs, Reg, Off);
-hp_dep_only([{N,_,_}|Xs], Reg, Off) ->
- [N|hp_dep_only(Xs, Reg, Off)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Control dependences:
-%% - add dependences so that
-%% * branches are performed in order
-%% * unsafe operations are 'fenced in' by surrounding branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the DAG
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd(IxBB,DAG) ->
- cd(IxBB, DAG, none, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% PrevBr - previous branch
-%% PrevUnsafe - previous unsafe instr (mem-op)
-%% PrevOthers - previous other instrs, used to "fix" preceeding
-%% instrs so they don't bypass a branch.
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the graph.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) ->
- DAG;
-cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) ->
- case cd_type(I) of
- {branch,Ty} ->
- DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG),
- NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1),
- cd(Xs,NewDAG,{N,Ty},[],[]);
- {unsafe,Ty} ->
- NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG),
- cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers);
- {other,_Ty} ->
- cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers])
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_to_other_deps
-%% Argument : N - index of branch
-%% Ms - list of indexes of "others" preceding instrs
-%% DAG - dependence graph
-%% Returns : DAG - new graph
-%% Description : Makes preceding instrs fixed so they don't bypass a branch
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_to_other_deps(_, [], DAG) ->
- DAG;
-cd_branch_to_other_deps(N, [M | Ms], DAG) ->
- cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)).
-
-%% Is the operation a branch, an unspeculable op or something else?
-
-%% Returns
-%% {branch,BranchType}
-%% {unsafe,OpType}
-%% {other,OpType}
-
-%% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_type
-%% Argument : I - instr
-%% Description : Maps instrs to a simpler type.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_type(I) ->
- case I of
- #goto{} ->
- {branch,uncond};
- #br{} ->
- {branch,'cond'};
- #b{} ->
- {branch,'cond'};
- #call_link{} ->
- {branch,call};
- #jmp_link{} ->
- {branch,call};
- #jmp{} ->
- {branch,call};
- #load{} ->
- {unsafe,load};
- #store{} ->
- {unsafe,load};
- T ->
- {other,T}
- end.
-
-%% add dependences to keep order of branches + unspeculable ops:
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_deps
-%% Argument : PrevBr - preceeding branch
-%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops
-%% N - current id.
-%% Ty - type of current instr
-%% DAG - dependence graph
-%% Returns : DAG - new DAG
-%% Description : Adds arcs between branches and calls deps_to_unsafe that adds
-%% arcs between branches and unsafe ops.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) ->
- DAG1 = case PrevBr of
- none ->
- DAG;
- {Br,BrTy} ->
- dep_arc(Br,
- hipe_target_machine:br_br_latency(BrTy,Ty),
- N, DAG)
- end,
- deps_to_unsafe(PrevUnsafe, N, Ty, DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps_to_unsafe
-%% Description : Adds dependencies between unsafe's and branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps_to_unsafe([], _, _, DAG) -> DAG;
-deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) ->
- deps_to_unsafe(Us,N,Ty,
- dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty),
- N, DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_unsafe_deps
-%% Description : Adds dependencies between branches and unsafe's
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_unsafe_deps(none, _, _, DAG) ->
- DAG;
-cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) ->
- dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : def_use
-%% Argument : Instr
-%% Description : Returns the registers that Instr defines resp. uses as 2 lists
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-def_use(Instr) ->
- {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : move_or_alu
-%% Description : True if the instruction is a move or an alu; false otherwise
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-move_or_alu(#move{}) -> true;
-move_or_alu(#alu{}) -> true;
-move_or_alu(_) -> false.
-
-%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--ifdef(debug1).
-debug1_stuff(Blk, DAG, IxBlk, Sch, X) ->
- io:format("Blk: ~p~n",[Blk]),
- io:format("DAG: ~n~p~n~p",[DAG,IxBlk]),
- io:format("~n"),
- print_instrs(IxBlk),
- print_sch(Sch, IxBlk),
- print_instrs2(X).
-
-print_instrs([]) ->
- io:format("~n");
-print_instrs([{N,Instr} | Instrs]) ->
- io:format("(~p): ",[N]),
- hipe_sparc_pp:pp_instr(Instr),
- io:format("~p~n",[element(1,Instr)]),
- print_instrs(Instrs).
-
-print_instrs2([]) ->
- io:format("~n");
-print_instrs2([Instr | Instrs]) ->
- hipe_sparc_pp:pp_instr(Instr),
- print_instrs2(Instrs).
-
-print_sch([],_) -> io:format("~n");
-print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) ->
- io:format("{C~p, N~p} ",[Cycle,I]),
- print_node(I, IxBlk),
- print_sch(Rest, IxBlk).
-
-print_node(_, []) ->
- io:format("~n");
-print_node(I, [{I, Instr} | _]) ->
- hipe_sparc_pp:pp_instr(Instr);
-print_node(I, [_ | IxBlk]) ->
- print_node(I, IxBlk).
--else.
-debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) ->
- ok.
--endif.
diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl
deleted file mode 100644
index 339bb82aab..0000000000
--- a/lib/hipe/opt/hipe_schedule_prio.erl
+++ /dev/null
@@ -1,53 +0,0 @@
-%% -*- erlang-indent-level: 2 -*-
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% - at present, all nodes have the same priority and so on.
-%%
-%% *** UNFINISHED ***
-%% - should compute a static priority estimate
-%% - should dynamically modify priorities + possibly insert NOPs
-%% (e.g., to separate branches, etc.)
-%% - thus, ought to be passed the current schedule and/or resources as well
-
--module(hipe_schedule_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
-init_ready(Size,Preds) ->
- hipe_ultra_prio:init_ready(Size,Preds).
-
-init_instr_prio(N,DAG) ->
- hipe_ultra_prio:init_instr_prio(N,DAG).
-
-%% initial_ready_set(M,N,Preds,Ready) ->
-%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready).
-
-next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) ->
- hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl).
-
-add_ready_nodes(NodeLst,Ready) ->
- hipe_ultra_prio:add_ready_nodes(NodeLst,Ready).
-
-insert_node(C,I,Ready) ->
- hipe_ultra_prio:insert_node(C,I,Ready).
diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl
deleted file mode 100644
index 75993cb95e..0000000000
--- a/lib/hipe/opt/hipe_target_machine.erl
+++ /dev/null
@@ -1,87 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INTERFACE TO TARGET MACHINE MODEL
-%%
-%% Interfaces the instruction scheduler to the (resource) machine model.
-
--module(hipe_target_machine).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--define(target,hipe_ultra_mod2).
-
-init_resources(X) ->
- ?target:init_resources(X).
-
-init_instr_resources(X,Y) ->
- ?target:init_instr_resources(X,Y).
-
-resources_available(X,Y,Z,W) ->
- ?target:resources_available(X,Y,Z,W).
-
-advance_cycle(X) ->
- ?target:advance_cycle(X).
-
-raw_latency(From,To) ->
- ?target:raw_latency(From,To).
-
-war_latency(From,To) ->
- ?target:war_latency(From,To).
-
-waw_latency(From,To) ->
- ?target:waw_latency(From,To).
-
-%% m_raw_latency(From,To) ->
-%% ?target:m_raw_latency(From,To).
-
-%% m_war_latency(From,To) ->
-%% ?target:m_war_latency(From,To).
-
-%% m_waw_latency(From,To) ->
-%% ?target:m_waw_latency(From,To).
-
-m_raw_latency() ->
- ?target:m_raw_latency().
-
-m_war_latency() ->
- ?target:m_war_latency().
-
-m_waw_latency() ->
- ?target:m_waw_latency().
-
-br_to_unsafe_latency(Br,U) ->
- ?target:br_to_unsafe_latency(Br,U).
-
-unsafe_to_br_latency(U,Br) ->
- ?target:unsafe_to_br_latency(U,Br).
-
-br_br_latency(Br1,Br2) ->
- ?target:br_br_latency(Br1,Br2).
diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl
deleted file mode 100644
index cec9c56a1e..0000000000
--- a/lib/hipe/opt/hipe_ultra_mod2.erl
+++ /dev/null
@@ -1,233 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% ULTRASPARC MACHINE MODEL
-%%
-%% This module is used by the scheduler.
-%% The following interface is used:
-%% ...
-%%
-%% NOTES:
-%% - the machine model is simple (on the verge of simplistic)
-%% * all FUs are pipelined => model only one cycle at a time
-%% * instruction latencies are mostly 1
-%% * floating point is left for later (I _think_ it works, but ...)
-%% - conservative: instructions that require multiple resources are
-%% modelled as 'single'; instead, they could reserve IEU+BR or whatever
-%% - possibly inefficient: I think machine state model could be turned into
-%% a bitvector.
-
--module(hipe_ultra_mod2).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
--define(debug(Str,Args),ok).
-%-define(debug(Str,Args),io:format(Str,Args)).
-
--define(debug_ultra(Str,Args),ok).
-%-define(debug_ultra(Str,Args),io:format(Str,Args)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Straightforward and somewhat simplistic model for UltraSparc:
-%% - only one cycle at a time is modelled
-%% - resources are simplified:
-%% * ieu0, ieu1, ieu, mem, br, single
-%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br }
-%% * unoptimized representation (could be bit vector)
-
-init_resources(_Size) ->
- ?debug_ultra('init res ~p~n',[_Size]),
- empty_state().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-init_instr_resources(N,Nodes) ->
- ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')).
-
-ultra_instr_rsrcs([],I_res) -> I_res;
-ultra_instr_rsrcs([N|Ns],I_res) ->
- ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)).
-
-ultra_instr_type({N,I},I_res) ->
- hipe_vectors:set(I_res,N-1,instr_type(I)).
-
-instr_type(I) ->
- case I of
- #move{} ->
- ieu;
- #multimove{} -> %% TODO: expand multimoves before scheduling
- ieu;
- #alu{} ->
- case hipe_sparc:alu_operator(I) of
- '>>' -> ieu0;
- '<<' -> ieu0;
- _ -> ieu
- end;
- #alu_cc{} ->
- ieu1;
- #sethi{} ->
- ieu;
- #load{} ->
- mem;
- #store{} ->
- mem;
- #b{} ->
- br;
- #br{} ->
- br;
- #goto{} ->
- br;
- #jmp_link{} -> % imprecise; should be mem+br?
- single;
- #jmp{} -> % imprecise
- br;
- #call_link{} -> % imprecise; should be mem+br?
- single;
- #cmov_cc{} -> % imprecise
- single;
- #cmov_r{} -> % imprecise
- single;
- #load_atom{} -> % should be resolved to sethi/or
- single;
- #load_address{} -> % should be resolved to sethi/or
- single;
- #load_word_index{} -> % should be resolved to sethi/or
- single;
- %% uncommon types:
- #label{} ->
- none;
- #nop{} ->
- none;
- #comment{} ->
- none;
- _ ->
- exit({ultrasparc_instr_type,{cant_schedule,I}})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-resources_available(_Cycle, I, Rsrc, I_res) ->
- res_avail(instruction_resource(I_res, I), Rsrc).
-
-instruction_resource(I_res, I) ->
- hipe_vectors:get(I_res, I-1).
-
-%% The following function checks resource availability.
-%% * all function units are assumed to be fully pipelined, so only
-%% one cycle at a time is modelled.
-%% * for IEU0 and IEU1, these must precede all generic IEU instructions
-%% (handled by X bit)
-%% * at most 2 integer instructions can issue in a cycle
-%% * mem is straightforward
-%% * br closes the cycle (= returns done).
-%% * single requires an entirely empty state and closes the cycle
-
-res_avail(ieu0, { free, I1, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { occ, I1, NumI+1, free, Mem, Br }};
-res_avail(ieu1, { _I0, free, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { free, occ, NumI+1, free, Mem, Br }};
-res_avail(ieu, { I0, I1, NumI, _X, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { I0, I1, NumI+1, occ, Mem, Br }};
-res_avail(mem, { I0, I1, NumI, X, free, Br }) ->
- { yes, { I0, I1, NumI, X, occ, Br }};
-res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) ->
- { yes, done };
-res_avail(single, { free, free, 0, free, free, free }) ->
- { yes, done };
-res_avail(_, _) ->
- no.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-advance_cycle(_Rsrc) ->
- empty_state().
-
-empty_state() -> { free, free, 0, free, free, free }.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Latencies are taken from UltraSparc hardware manual
-%%
-%% *** UNFINISHED ***
-%% more precisely, they are taken from my memory of the US-manual
-%% at the moment.
-%%
-%% Note: all ld/st are assumed to hit in the L1 cache (D-cache),
-%% which is sort of imprecise.
-
-raw_latency(alu, store) -> 0;
-raw_latency(load, _) -> 2; % only if load is L1 hit
-raw_latency(alu_cc, b) -> 0;
-raw_latency(_I0, _I1) ->
- 1.
-
-war_latency(_I0, _I1) ->
- 0.
-
-waw_latency(_I0, _I1) ->
- 1.
-
-%% *** UNFINISHED ***
-%% At present, all load/stores are assumed to hit in the L1 cache,
-%% which isn't really satisfying.
-
-%% m_raw_latency(_St, _Ld) ->
-%% 1.
-%%
-%% m_war_latency(_Ld, _St) ->
-%% 1.
-%%
-%% m_waw_latency(_St1, _St2) ->
-%% 1.
-
-%% Use these for 'default latencies' = do not permit reordering.
-
-m_raw_latency() ->
- 1.
-
-m_war_latency() ->
- 1.
-
-m_waw_latency() ->
- 1.
-
-br_to_unsafe_latency(_BrTy, _UTy) ->
- 0.
-
-unsafe_to_br_latency(_UTy, _BrTy) ->
- 0.
-
-br_br_latency(_BrTy1, _BrTy2) ->
- 0.
diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl
deleted file mode 100644
index 6dd240a33a..0000000000
--- a/lib/hipe/opt/hipe_ultra_prio.erl
+++ /dev/null
@@ -1,298 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% Priorities are mainly from the critical path. More priorities are added.
-%% * One version is adding priorities just depending on the instr, so
-%% for example loads get higher priority than stores, and ordered
-%% after reg's and offset for better cache performance.
-%% * The other version gives higher priority to a node that adds more new
-%% nodes to the ready list. This one is maybe not so effectively
-%% implemented, but was added too late for smarter solutions.
-%% One version is commented away
-
--module(hipe_ultra_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
-% At first, only nodes with no predecessors are selected.
-% - if R is empty, there is an error (unless BB itself is empty)
-
-%% Arguments : Size - size of ready-array
-%% Preds - array with number of predecessors for each node
-%% Returns : An array with list of ready-nodes for each cycle.
-
-init_ready(Size, Preds) ->
- P = hipe_vectors:size(Preds),
- Ready = hipe_vectors:new(Size, []),
- R = initial_ready_set(1, P, Preds, []),
- hipe_vectors:set(Ready, 0, R).
-
-init_instr_prio(N, DAG) ->
- critical_path(N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : initial_ready_set
-%% Argument : M - current node-index
-%% N - where to stop
-%% Preds - array with number of predecessors for each node
-%% Ready - list with ready-nodes
-%% Returns : Ready - list with ready-nodes
-%% Description : Finds all nodes with no predecessors and adds them to ready.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-initial_ready_set(M, N, Preds, Ready) ->
- if
- M > N ->
- Ready;
- true ->
- case hipe_vectors:get(Preds, M-1) of
- 0 ->
- initial_ready_set(M+1, N, Preds, [M|Ready]);
- V when is_integer(V), V > 0 ->
- initial_ready_set(M+1, N, Preds, Ready)
- end
- end.
-
-%% The following handles the nodes ready to schedule:
-%% 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady}
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : next_ready
-%% Argument : C - current cycle
-%% Ready - array with ready nodes
-%% Prio - array with cpath-priorities for all nodes
-%% Nodes - indexed list [{N, Instr}]
-%% Returns : none / {next,Highest_Prio,NewReady}
-%% Description : 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady} where Highest_Prio
-%% = Id of instr and NewReady = updated ready-array.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) ->
- Curr = hipe_vectors:get(Ready, C-1),
- case Curr of
- [] ->
- none;
- Instrs ->
- {BestI,RestIs} =
- get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C),
- {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)}
- end.
-
-% next_ready(C,Ready,Prio,Nodes) ->
-% Curr = hipe_vectors:get(Ready,C-1),
-% case Curr of
-% [] ->
-% none;
-% Instrs ->
-% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes),
-% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)}
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_best_instr
-%% Argument : Instrs - list of node-id's
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's
-%% Description : Returns the id of the instr that is the best choice.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) ->
- get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C).
-
-get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) ->
- {BestSoFar, Rest};
-get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes,
- DAG, Preds, Earl, C) ->
- case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of
- true ->
- get_best_instr(Instrs, [BestSoFar|PassedInstrs],
- Instr, Prio, Nodes, DAG, Preds, Earl, C);
- false ->
- get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio,
- Nodes, DAG, Preds, Earl, C)
- end.
-
-% get_best_instr([Instr|Instrs], Prio, Nodes) ->
-% get_best_instr(Instrs, [], Instr, Prio, Nodes).
-
-% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest};
-% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) ->
-% case better(Instr, BestSoFar, Prio, Nodes) of
-% true ->
-% get_best_instr(Instrs, [BestSoFar|PassedInstrs],
-% Instr, Prio, Nodes);
-% false ->
-% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes)
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : better
-%% Argument : Instr1 - Id of instr 1
-%% Instr2 - Id of instr 2
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : true if Instr1 has higher priority than Instr2
-%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) ->
- better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C),
- priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)).
-
-better_hlp([], []) -> false;
-better_hlp([], [_|_]) -> false;
-better_hlp([_|_], []) -> true;
-better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)).
-
-%%
-%% Returns the instr corresponding to id
-%%
-get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr;
-get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : priority
-%% Argument : InstrId - Id
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...]
-%% Description : Returns a list of priorities where the first element is the
-%% cpath-priority and the rest are added depending on what kind
-%% of instr it is. Used to order loads/stores sequentially and
-%% there is possibility to add whatever stuff...
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) ->
- {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl),
- Instr = get_instr(InstrId, Nodes),
- Prio1 = hipe_vectors:get(Prio, InstrId-1),
- Prio2 = length(ReadyNodes),
- PrioRest =
- case Instr of
- #load_atom{} ->
- [3];
- #move{} ->
- [3];
- #load{} ->
- Src = hipe_sparc:load_src(Instr),
- Off = hipe_sparc:load_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [3,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- #store{} ->
- Src = hipe_sparc:store_dest(Instr),
- Off = hipe_sparc:store_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [2,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- _ -> [0]
- end,
- [Prio1,Prio2|PrioRest].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_ready_nodes
-%% Argument : Nodes - list of [{Cycle,Id}]
-%% Ready - array of ready nodes for all cycles
-%% Returns : NewReady - updated ready-array
-%% Description : Gets a list of instrs and adds them to the ready-array
-%% to the corresponding cycle.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-add_ready_nodes([], Ready) -> Ready;
-add_ready_nodes([{C,I}|Xs], Ready) ->
- add_ready_nodes(Xs, insert_node(C, I, Ready)).
-
-insert_node(C, I, Ready) ->
- Old = hipe_vectors:get(Ready, C-1),
- hipe_vectors:set(Ready, C-1, [I|Old]).
-
-%%
-%% Computes the latency for the "most expensive" way through the graph
-%% for all nodes. Returns an array of priorities for all nodes.
-%%
-critical_path(N, DAG) ->
- critical_path(1, N, DAG, hipe_vectors:new(N, -1)).
-
-critical_path(M, N, DAG, Prio) ->
- if
- M > N ->
- Prio;
- true ->
- critical_path(M+1, N, DAG, cpath(M, DAG, Prio))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cpath
-%% Argument : M - current node id
-%% DAG - the dependence graph
-%% Prio - array of priorities for all nodes
-%% Returns : Prio - updated prio array
-%% Description : If node has prio -1, it has not been visited
-%% - otherwise, compute priority as max of priorities of
-%% successors (+ latency)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-cpath(M, DAG, Prio) ->
- InitPrio = hipe_vectors:get(Prio, M-1),
- if
- InitPrio =:= -1 ->
- cpath_node(M, DAG, Prio);
- true ->
- Prio
- end.
-
-cpath_node(N, DAG, Prio) ->
- SuccL = dag_succ(DAG, N),
- {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio),
- hipe_vectors:set(NewPrio, N-1, Max).
-
-cpath_succ(SuccL, DAG, Prio) ->
- cpath_succ(SuccL, DAG, Prio, 0).
-
-%% performs an unnecessary lookup of priority of Succ, but that might
-%% not be such a big deal
-
-cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio};
-cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) ->
- NewPrio = cpath(Succ, DAG, Prio),
- NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio),
- cpath_succ(Xs, DAG, NewPrio, NewNodePrio).
-
-dag_succ(DAG, N) when is_integer(N) ->
- hipe_vectors:get(DAG, N-1).
-
diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile
index 5abc9ec049..becdd0b7d8 100644
--- a/lib/hipe/rtl/Makefile
+++ b/lib/hipe/rtl/Makefile
@@ -50,7 +50,7 @@ HIPE_MODULES = hipe_rtl hipe_rtl_cfg \
hipe_rtl_ssa hipe_rtl_ssa_const_prop \
hipe_rtl_cleanup_const hipe_rtl_symbolic hipe_rtl_lcm \
hipe_rtl_ssapre hipe_rtl_binary hipe_rtl_ssa_avail_expr \
- hipe_rtl_arch hipe_tagscheme
+ hipe_rtl_arch hipe_tagscheme hipe_rtl_verify_gcsafe
else
HIPE_MODULES =
endif
diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl
index 04c9728d5c..33027f3259 100644
--- a/lib/hipe/rtl/hipe_rtl.erl
+++ b/lib/hipe/rtl/hipe_rtl.erl
@@ -1740,7 +1740,10 @@ pp_reg(Dev, Arg) ->
true ->
pp_hard_reg(Dev, reg_index(Arg));
false ->
- io:format(Dev, "r~w", [reg_index(Arg)])
+ case reg_is_gcsafe(Arg) of
+ true -> io:format(Dev, "rs~w", [reg_index(Arg)]);
+ false -> io:format(Dev, "r~w", [reg_index(Arg)])
+ end
end.
pp_var(Dev, Arg) ->
diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
index ec7044a2b9..111dda3d82 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
@@ -363,7 +363,8 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit,
allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) ->
Zero = hipe_rtl:mk_imm(0),
[NextLbl] = create_lbls(1),
- [EndSubSize, EndSubBitSize, ProcBin] = create_regs(3),
+ [EndSubSize, EndSubBitSize] = create_regs(2),
+ [ProcBin] = create_unsafe_regs(1),
[hipe_rtl:mk_call([Base], bs_allocate, [UsedBytes],
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
@@ -590,12 +591,12 @@ const_init2(Size, Dst, Base, Offset, TrueLblName) ->
false ->
ByteSize = hipe_rtl:mk_new_reg(),
[hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
- hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm(Size)),
hipe_rtl:mk_call([Base], bs_allocate, [ByteSize],
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
hipe_tagscheme:create_refc_binary(Base, ByteSize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName)]
end.
@@ -638,13 +639,12 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
Log2WordSize = hipe_rtl_arch:log2_word_size(),
WordSize = hipe_rtl_arch:word_size(),
[ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4),
- [USize, Tmp] = create_unsafe_regs(2),
+ [USize, Tmp] = create_regs(2),
[get_word_integer(Size, USize, SystemLimitLblName, FalseLblName),
hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE),
hipe_rtl:label_name(ContLbl),
SystemLimitLblName),
ContLbl,
- hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE),
hipe_rtl:label_name(HeapLbl),
hipe_rtl:label_name(REFCLbl)),
@@ -654,6 +654,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
hipe_rtl:mk_alu(Tmp, Tmp, add, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)),
hipe_rtl:mk_gctest(Tmp),
hipe_tagscheme:create_heap_binary(Base, USize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName),
REFCLbl,
hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
@@ -661,6 +662,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
hipe_tagscheme:create_refc_binary(Base, USize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName)].
var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) ->
@@ -867,7 +869,7 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) ->
JoinLbl,
hipe_tagscheme:test_heap_binary(Orig, HeapLblName, REFCLblName),
HeapLbl,
- hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, SrcBase),
hipe_rtl:mk_goto(EndLblName),
REFCLbl,
hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase),
@@ -1214,6 +1216,12 @@ is_divisible(Dividend, Divisor, SuccLbl, FailLbl) ->
[hipe_rtl:mk_branch(Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)];
false ->
%% We need division, fall back to a primop
- [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)],
- SuccLbl, FailLbl, not_remote)]
+ [Tmp] = create_regs(1),
+ RetLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([Tmp], is_divisible,
+ [Dividend, hipe_rtl:mk_imm(Divisor)],
+ hipe_rtl:label_name(RetLbl), [], not_remote),
+ RetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ SuccLbl, FailLbl, 0.99)]
end.
diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
index 362a52f8fe..4575213838 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_match.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -730,7 +730,7 @@ get_base(Orig,Base) ->
[hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl),
hipe_rtl:label_name(REFCLbl)),
HeapLbl,
- hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, Base),
hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)),
REFCLbl,
get_field_from_term({proc_bin, flags}, Orig, Flags),
@@ -740,7 +740,7 @@ get_base(Orig,Base) ->
WritableLbl,
hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'),
NotWritableLbl,
- hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)),
+ get_field_from_term({proc_bin, bytes}, Orig, Base),
EndLbl].
extract_matchstate_var(binsize, Ms) ->
@@ -842,12 +842,12 @@ make_dyn_prep(SizeReg, CCode) ->
%%------------------------------------------------------------------------
get_unaligned_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName) ->
- [Reg] = create_regs(1),
+ [Reg] = create_gcsafe_regs(1),
[get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type),
do_bignum_code(Size, Type, Reg, Dst1, TrueLblName)].
get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type) ->
- [LowBits] = create_regs(1),
+ [LowBits] = create_gcsafe_regs(1),
[AlignedLbl, UnAlignedLbl, EndLbl] = create_lbls(3),
[hipe_rtl:mk_alub(LowBits, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS),
eq, hipe_rtl:label_name(AlignedLbl),
@@ -1001,7 +1001,7 @@ do_bignum_code(Size, {Signedness,_}, Src, Dst1, TrueLblName)
end.
signed_bignum(Dst1, Src, TrueLblName) ->
- Tmp1 = hipe_rtl:mk_new_reg(),
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
BignumLabel = hipe_rtl:mk_new_label(),
[hipe_tagscheme:realtag_fixnum(Dst1, Src),
hipe_tagscheme:realuntag_fixnum(Tmp1, Dst1),
diff --git a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
index bfa6b9682e..00cc2bcb37 100644
--- a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
+++ b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
@@ -69,9 +69,9 @@ cleanup_instr([Const|Left], I, Acc) ->
case I of
X when is_record(X, fp_unop) orelse is_record(X, fp) ->
Fdst = hipe_rtl:mk_new_fpreg(),
- Fconv = hipe_tagscheme:unsafe_untag_float(Fdst, Dst),
+ Fconv = lists:flatten(hipe_tagscheme:unsafe_untag_float(Fdst, Dst)),
NewI = hipe_rtl:subst_uses([{Const, Fdst}], I),
- cleanup_instr(Left, NewI, Fconv ++ [Load|Acc]);
+ cleanup_instr(Left, NewI, lists:reverse(Fconv, [Load|Acc]));
_ ->
NewI = hipe_rtl:subst_uses([{Const, Dst}], I),
cleanup_instr(Left, NewI, [Load|Acc])
diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl
index 9dcdd05fb1..2c8cc80e56 100644
--- a/lib/hipe/rtl/hipe_rtl_lcm.erl
+++ b/lib/hipe/rtl/hipe_rtl_lcm.erl
@@ -182,42 +182,41 @@ delete_exprs(Code, _, _, []) ->
Code;
delete_exprs(Code, ExprMap, IdMap, [ExprId|Exprs]) ->
Expr = expr_id_map_get_expr(IdMap, ExprId),
- %% Perform a foldl that goes through the code and deletes all
- %% occurences of the expression.
- NewCode =
- lists:reverse
- (lists:foldl(fun(CodeExpr, Acc) ->
- case is_expr(CodeExpr) of
- true ->
- case expr_clear_dst(CodeExpr) =:= Expr of
- true ->
- pp_debug(" Deleting: ", []),
- pp_debug_instr(CodeExpr),
- %% Lookup expression entry.
- Defines =
- case expr_map_lookup(ExprMap, Expr) of
- {value, {_, _, Defs}} ->
- Defs;
- none ->
- exit({?MODULE, expr_map_lookup,
- "expression missing"})
- end,
- MoveCode =
- mk_expr_move_instr(hipe_rtl:defines(CodeExpr),
- Defines),
- pp_debug(" Replacing with: ", []),
- pp_debug_instr(MoveCode),
- [MoveCode|Acc];
- false ->
- [CodeExpr|Acc]
- end;
- false ->
- [CodeExpr|Acc]
- end
- end,
- [], Code)),
+ %% Lookup expression entry.
+ {value, {_, _, Defines}} = expr_map_lookup(ExprMap, Expr),
+ %% Go through the code and deletes all occurences of the expression.
+ NewCode = delete_expr(Code, Expr, Defines, []),
delete_exprs(NewCode, ExprMap, IdMap, Exprs).
+delete_expr([], _Expr, _Defines, Acc) -> lists:reverse(Acc);
+delete_expr([CodeExpr|Code], Expr, Defines, Acc) ->
+ case exp_kill_expr(CodeExpr, [Expr]) of
+ [] -> % Expr was killed; deleting stops here
+ pp_debug(" Stopping before: ", []),
+ pp_debug_instr(CodeExpr),
+ lists:reverse(Acc, [CodeExpr|Code]);
+ [Expr] ->
+ NewCodeExpr =
+ case is_expr(CodeExpr) of
+ true ->
+ case expr_clear_dst(CodeExpr) =:= Expr of
+ true ->
+ pp_debug(" Deleting: ", []),
+ pp_debug_instr(CodeExpr),
+ MoveCode = mk_expr_move_instr(hipe_rtl:defines(CodeExpr),
+ Defines),
+ pp_debug(" Replacing with: ", []),
+ pp_debug_instr(MoveCode),
+ MoveCode;
+ false ->
+ CodeExpr
+ end;
+ false ->
+ CodeExpr
+ end,
+ delete_expr(Code, Expr, Defines, [NewCodeExpr|Acc])
+ end.
+
%%=============================================================================
%% Goes through the given list of expressions and inserts them at
%% appropriate places in the code.
@@ -226,13 +225,12 @@ insert_exprs(CFG, _, _, _, _, BetweenMap, []) ->
insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) ->
Expr = expr_id_map_get_expr(IdMap, ExprId),
Instr = expr_map_get_instr(ExprMap, Expr),
- case hipe_rtl_cfg:succ(CFG, Pred) of
- [_] ->
+ case try_insert_expr_last(CFG, Pred, Instr) of
+ {ok, NewCFG} ->
pp_debug(" Inserted last: ", []),
pp_debug_instr(Instr),
- NewCFG = insert_expr_last(CFG, Pred, Instr),
insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, BetweenMap, Exprs);
- _ ->
+ not_safe ->
case hipe_rtl_cfg:pred(CFG, Succ) of
[_] ->
pp_debug(" Inserted first: ", []),
@@ -252,25 +250,34 @@ insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) ->
%% Recursively goes through the code in a block and returns a new block
%% with the new code inserted second to last (assuming the last expression
%% is a branch operation).
-insert_expr_last(CFG0, Label, Instr) ->
- Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
- %% FIXME: Use hipe_bb:butlast() instead?
- Code1 = insert_expr_last_work(Label, Instr, Code0),
- hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1)).
+try_insert_expr_last(CFG0, Label, Instr) ->
+ case hipe_rtl_cfg:succ(CFG0, Label) of
+ [_] ->
+ Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
+ case insert_expr_last_work(Instr, Code0) of
+ not_safe -> not_safe;
+ Code1 ->
+ {ok, hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1))}
+ end;
+ _ -> not_safe
+ end.
%%=============================================================================
%% Recursively goes through the code in a block and returns a new block
%% with the new code inserted second to last (assuming the last expression
%% is a branch operation).
-insert_expr_last_work(_, Instr, []) ->
- %% This case should not happen since this means that block was completely
- %% empty when the function was called. For compatibility we insert it last.
- [Instr];
-insert_expr_last_work(_, Instr, [Code1]) ->
+insert_expr_last_work(_Instr, [#call{}]) ->
+ %% Call instructions clobber all expressions; we must not insert the
+ %% expression before it
+ not_safe;
+insert_expr_last_work(Instr, [Code1]) ->
%% We insert the code next to last.
[Instr, Code1];
-insert_expr_last_work(Label, Instr, [Code|Codes]) ->
- [Code|insert_expr_last_work(Label, Instr, Codes)].
+insert_expr_last_work(Instr, [Code|Codes]) ->
+ case insert_expr_last_work(Instr, Codes) of
+ not_safe -> not_safe;
+ NewCodes -> [Code|NewCodes]
+ end.
%%=============================================================================
%% Inserts expression first in the block for the given label.
@@ -305,7 +312,8 @@ insert_expr_between(CFG0, BetweenMap, Pred, Succ, Instr) ->
{value, Label} ->
pp_debug(" Using existing new bb for edge (~w,~w) with label ~w~n",
[Pred, Succ, Label]),
- {insert_expr_last(CFG0, Label, Instr), BetweenMap}
+ {ok, NewCfg} = try_insert_expr_last(CFG0, Label, Instr),
+ {NewCfg, BetweenMap}
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl
index 850a75f71b..ce5433379e 100644
--- a/lib/hipe/rtl/hipe_rtl_primops.erl
+++ b/lib/hipe/rtl/hipe_rtl_primops.erl
@@ -291,6 +291,10 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
gen_select_msg(Dst, Cont);
clear_timeout ->
gen_clear_timeout(Dst, GotoCont);
+ recv_mark ->
+ gen_recv_mark(Dst, GotoCont);
+ recv_set ->
+ gen_recv_set(Dst, Cont);
set_timeout ->
%% BIF call: am_set_timeout -> nbif_set_timeout -> hipe_set_timeout
[hipe_rtl:mk_call(Dst, set_timeout, Args, Cont, Fail, not_remote)];
@@ -390,6 +394,10 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
end;
debug_native_called ->
[hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
+ build_stacktrace ->
+ [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
+ raw_raise ->
+ [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
%% Only names listed above are accepted! MFA:s are not primops!
_ ->
@@ -1064,6 +1072,27 @@ gen_tuple_header(Ptr, Arity) ->
%%%
%%% Receives
+%%% recv_mark is:
+%%% p->msg.saved_last = p->msg.last;
+gen_recv_mark([], GotoCont) ->
+ TmpLast = hipe_rtl:mk_new_reg(),
+ [load_p_field(TmpLast, ?P_MSG_LAST),
+ store_p_field(TmpLast, ?P_MSG_SAVED_LAST),
+ GotoCont].
+
+%%% recv_set is:
+%%% if (p->msg.saved_last)
+%%% p->msg.save = p->msg.saved_last;
+gen_recv_set([], Cont) ->
+ TmpSave = hipe_rtl:mk_new_reg(),
+ TrueLbl = hipe_rtl:mk_new_label(),
+ [load_p_field(TmpSave, ?P_MSG_SAVED_LAST),
+ hipe_rtl:mk_branch(TmpSave, ne, hipe_rtl:mk_imm(0),
+ hipe_rtl:label_name(TrueLbl), Cont),
+ TrueLbl,
+ store_p_field(TmpSave, ?P_MSG_SAVE),
+ hipe_rtl:mk_goto(Cont)].
+
gen_check_get_msg(Dsts, GotoCont, Fail) ->
gen_check_get_msg_outofline(Dsts, GotoCont, Fail).
diff --git a/lib/hipe/rtl/hipe_rtl_varmap.erl b/lib/hipe/rtl/hipe_rtl_varmap.erl
index 375a8f85c0..f34c66ab85 100644
--- a/lib/hipe/rtl/hipe_rtl_varmap.erl
+++ b/lib/hipe/rtl/hipe_rtl_varmap.erl
@@ -105,7 +105,7 @@ icode_var2rtl_var(Var, Map) ->
{reg, IsGcSafe} ->
NewVar =
case IsGcSafe of
- %% true -> hipe_rtl:mk_new_reg_gcsafe();
+ true -> hipe_rtl:mk_new_reg_gcsafe();
false -> hipe_rtl:mk_new_reg()
end,
{NewVar, insert(Var, NewVar, Map)}
diff --git a/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
new file mode 100644
index 0000000000..01d7e89ccd
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
@@ -0,0 +1,89 @@
+%% -*- mode: erlang; erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+-module(hipe_rtl_verify_gcsafe).
+
+-export([check/1]).
+
+-include("../flow/cfg.hrl"). %% needed for the specs
+-include("hipe_rtl.hrl").
+
+check(CFG) ->
+ Liveness = hipe_rtl_liveness:analyze(CFG),
+ put({?MODULE, 'fun'}, CFG#cfg.info#cfg_info.'fun'),
+ lists:foreach(
+ fun(Lb) ->
+ put({?MODULE, label}, Lb),
+ Liveout = hipe_rtl_liveness:liveout(Liveness, Lb),
+ BB = hipe_rtl_cfg:bb(CFG, Lb),
+ check_instrs(lists:reverse(hipe_bb:code(BB)), Liveout)
+ end, hipe_rtl_cfg:labels(CFG)),
+ erase({?MODULE, 'fun'}),
+ erase({?MODULE, label}),
+ erase({?MODULE, instr}),
+ ok.
+
+check_instrs([], _Livein) -> ok;
+check_instrs([I|Is], LiveOut) ->
+ Def = ordsets:from_list(hipe_rtl:defines(I)),
+ Use = ordsets:from_list(hipe_rtl:uses(I)),
+ LiveOver = ordsets:subtract(LiveOut, Def),
+ LiveIn = ordsets:union(LiveOver, Use),
+ case (hipe_rtl:is_call(I)
+ andalso not safe_primop(hipe_rtl:call_fun(I)))
+ orelse is_record(I, gctest)
+ of
+ false -> ok;
+ true ->
+ put({?MODULE, instr}, I),
+ lists:foreach(fun verify_live/1, LiveOver)
+ end,
+ check_instrs(Is, LiveIn).
+
+verify_live(T) ->
+ case hipe_rtl:is_reg(T) of
+ false -> ok;
+ true ->
+ case hipe_rtl:reg_is_gcsafe(T) of
+ true -> ok;
+ false ->
+ error({gcunsafe_live_over_call,
+ get({?MODULE, 'fun'}),
+ {label, get({?MODULE, label})},
+ get({?MODULE, instr}),
+ T})
+ end
+ end.
+
+%% Primops that can't gc
+%% Note: This information is essentially duplicated from hipe_bif_list.m4
+safe_primop(is_divisible) -> true;
+safe_primop(is_unicode) -> true;
+safe_primop(cmp_2) -> true;
+safe_primop(eq_2) -> true;
+safe_primop(bs_allocate) -> true;
+safe_primop(bs_reallocate) -> true;
+safe_primop(bs_utf8_size) -> true;
+safe_primop(bs_get_utf8) -> true;
+safe_primop(bs_put_utf8) -> true;
+safe_primop(bs_utf16_size) -> true;
+safe_primop(bs_get_utf16) -> true;
+safe_primop(bs_validate_unicode_retract) -> true;
+safe_primop(bs_put_small_float) -> true;
+safe_primop(bs_put_bits) -> true;
+safe_primop(emasculate_binary) -> true;
+safe_primop(atomic_inc) -> true;
+%% Not noproc but manually verified
+safe_primop(bs_put_big_integer) -> true;
+safe_primop(_) -> false.
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
index 68cbe75e85..737f0ec5e3 100644
--- a/lib/hipe/rtl/hipe_tagscheme.erl
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -53,7 +53,8 @@
-export([test_subbinary/3, test_heap_binary/3]).
-export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]).
-export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]).
--export([get_field_from_term/3, get_field_from_pointer/3,
+-export([get_field_addr_from_term/3,
+ get_field_from_term/3, get_field_from_pointer/3,
set_field_from_term/3, set_field_from_pointer/3,
extract_matchbuffer/2, extract_binary_bytes/2]).
@@ -76,6 +77,10 @@
-define(TAG_PRIMARY_BOXED, 16#2).
-define(TAG_PRIMARY_IMMED1, 16#3).
+%% Only when ?ERTS_USE_LITERAL_TAG =:= 1
+-define(TAG_PTR_MASK__, 16#7).
+-define(TAG_LITERAL_PTR, 16#4).
+
-define(TAG_IMMED1_SIZE, 4).
-define(TAG_IMMED1_MASK, 16#F).
-define(TAG_IMMED1_PID, ((16#0 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
@@ -157,6 +162,38 @@ tag_cons(Res, X) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ptr_val(Res, X) ->
+ hipe_rtl:mk_alu(Res, X, 'and', hipe_rtl:mk_imm(bnot ?TAG_PTR_MASK__)).
+
+%% Returns {Base, Offset, Untag}. To be used like, for example:
+%% {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED),
+%% ...
+%% [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
+%%
+%% NB: Base might either be X or a new temp. It must thus not be modified.
+untag_ptr(X, Tag) ->
+ case ?ERTS_USE_LITERAL_TAG of
+ 0 ->
+ {X, -Tag, []};
+ 1 ->
+ Base = hipe_rtl:mk_new_reg(),
+ Untag = ptr_val(Base, X),
+ {Base, 0, Untag}
+ end.
+
+untag_ptr_nooffset(Dst, X, Tag) ->
+ %% We could just use ptr_val in all cases, but subtraction can use LEA on x86
+ %% and can be inlined into effective address computations on several
+ %% architectures.
+ case ?ERTS_USE_LITERAL_TAG of
+ 0 ->
+ hipe_rtl:mk_alu(Dst, X, 'sub', hipe_rtl:mk_imm(Tag));
+ 1 ->
+ ptr_val(Dst, X)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
%%% Operations to test if an object has a known type T.
test_nil(X, TrueLab, FalseLab, Pred) ->
@@ -171,7 +208,8 @@ test_is_boxed(X, TrueLab, FalseLab, Pred) ->
hipe_rtl:mk_branch(X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred).
get_header(Res, X) ->
- hipe_rtl:mk_load(Res, X, hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED))).
+ {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED),
+ [Untag, hipe_rtl:mk_load(Res, Base, hipe_rtl:mk_imm(Offset))].
mask_and_compare(X, Mask, Value, TrueLab, FalseLab, Pred) ->
Tmp = hipe_rtl:mk_new_reg_gcsafe(),
@@ -617,21 +655,25 @@ test_either_immed(Arg1, Arg2, TrueLab, FalseLab) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unsafe_car(Dst, Arg) ->
- hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST))).
+ {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST),
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_cdr(Dst, Arg) ->
+ {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST),
WordSize = hipe_rtl_arch:word_size(),
- hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST)+WordSize)).
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset+WordSize))].
unsafe_constant_element(Dst, Index, Tuple) -> % Index is an immediate
WordSize = hipe_rtl_arch:word_size(),
- Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
- hipe_rtl:mk_load(Dst, Tuple, hipe_rtl:mk_imm(Offset)).
+ {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index),
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate
WordSize = hipe_rtl_arch:word_size(),
- Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
- hipe_rtl:mk_store(Tuple, hipe_rtl:mk_imm(Offset), Value).
+ {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index),
+ [Untag, hipe_rtl:mk_store(Base, hipe_rtl:mk_imm(Offset), Value)].
%%% wrong semantics
%% unsafe_variable_element(Dst, Index, Tuple) -> % Index is an unknown fixnum
@@ -644,10 +686,12 @@ unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate
%% Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
%% Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
%% Shift = ?TAG_IMMED1_SIZE - 2,
-%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) + ?TAG_PRIMARY_BOXED,
+%% {Base, Off0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) - Off0,
%% [hipe_rtl:mk_alu(Tmp1, Index, 'srl', hipe_rtl:mk_imm(Shift)),
%% hipe_rtl:mk_alu(Tmp2, Tmp1, 'sub', hipe_rtl:mk_imm(OffAdj)),
-%% hipe_rtl:mk_load(Dst, Tuple, Tmp2)].
+%% Untag,
+%% hipe_rtl:mk_load(Base, Tuple, Tmp2)].
element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) ->
FixnumOkLab = hipe_rtl:mk_new_label(),
@@ -660,7 +704,7 @@ element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) ->
Offset = hipe_rtl:mk_new_reg_gcsafe(),
Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple
[untag_fixnum(UIndex, Index),
- hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Offset, UIndex, 'sll',
hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
hipe_rtl:mk_load(Dst, Ptr, Offset)];
@@ -769,7 +813,7 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) ->
hipe_rtl:mk_branch(ZeroIndex, 'geu', Arity, FailLabName,
hipe_rtl:label_name(IndexOkLab), 0.01),
IndexOkLab,
- hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Offset, UIndex, 'sll',
hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
hipe_rtl:mk_load(Dst, Ptr, Offset)].
@@ -777,11 +821,13 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unsafe_closure_element(Dst, Index, Closure) -> % Index is an immediate
- Offset = -(?TAG_PRIMARY_BOXED) %% Untag
+ %% XXX: Can there even be closure literals?
+ {Base, Offset0, Untag} = untag_ptr(Closure, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 %% Untag
+ ?EFT_ENV %% Field offset
%% Index from 1 to N hence -1)
+ (hipe_rtl_arch:word_size() * (hipe_rtl:imm_value(Index)-1)),
- hipe_rtl:mk_load(Dst, Closure, hipe_rtl:mk_imm(Offset)).
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
mk_fun_header() ->
hipe_rtl:mk_imm(?HEADER_FUN).
@@ -790,7 +836,7 @@ tag_fun(Res, X) ->
tag_boxed(Res, X).
%% untag_fun(Res, X) ->
-%% hipe_rtl:mk_alu(Res, X, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)).
+%% untag_ptr_nooffset(Res, X, ?TAG_PRIMARY_BOXED).
if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) ->
%% EmuAddressPtrReg = hipe_rtl:mk_new_reg(),
@@ -801,15 +847,15 @@ if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) ->
TrueLab0 = hipe_rtl:mk_new_label(),
%% TrueLab1 = hipe_rtl:mk_new_label(),
IsFunCode = test_closure(FunP, hipe_rtl:label_name(TrueLab0), BadFunLab, Pred),
+ {Base, Offset, Untag} = untag_ptr(FunP, ?TAG_PRIMARY_BOXED),
GetArityCode =
[TrueLab0,
%% Funp->arity contains the arity
- hipe_rtl:mk_load(ArityReg, FunP,
- hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
- ?EFT_ARITY)),
- hipe_rtl:mk_load(FEPtrReg, FunP,
- hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
- ?EFT_FE)),
+ Untag,
+ hipe_rtl:mk_load(ArityReg, Base,
+ hipe_rtl:mk_imm(Offset+?EFT_ARITY)),
+ hipe_rtl:mk_load(FEPtrReg, Base,
+ hipe_rtl:mk_imm(Offset+?EFT_FE)),
hipe_rtl:mk_load(AddressReg, FEPtrReg,
hipe_rtl:mk_imm(?EFE_NATIVE_ADDRESS))],
IsFunCode ++ GetArityCode.
@@ -927,20 +973,24 @@ test_subbinary(Binary, TrueLblName, FalseLblName) ->
unsafe_load_float(DstLo, DstHi, Src) ->
WordSize = hipe_rtl_arch:word_size(),
- Offset1 = -(?TAG_PRIMARY_BOXED) + WordSize,
+ {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED),
+ Offset1 = Offset0 + WordSize,
Offset2 = Offset1 + 4, %% This should really be 4 and not WordSize
case hipe_rtl_arch:endianess() of
little ->
- [hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
- hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)];
+ [Untag,
+ hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)];
big ->
- [hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
- hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)]
+ [Untag,
+ hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)]
end.
unsafe_untag_float(Dst, Src) ->
- Offset = -(?TAG_PRIMARY_BOXED) + hipe_rtl_arch:word_size(),
- [hipe_rtl:mk_fload(Dst, Src, hipe_rtl:mk_imm(Offset))].
+ {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + hipe_rtl_arch:word_size(),
+ [Untag, hipe_rtl:mk_fload(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_tag_float(Dst, Src) ->
{GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
@@ -999,8 +1049,9 @@ get_one_word_pos_bignum(USize, Size, Fail) ->
unsafe_get_one_word_pos_bignum(USize, Size) ->
WordSize = hipe_rtl_arch:word_size(),
- Imm = hipe_rtl:mk_imm(1*WordSize-?TAG_PRIMARY_BOXED),
- [hipe_rtl:mk_load(USize, Size, Imm)].
+ {Base, Offset, Untag} = untag_ptr(Size, ?TAG_PRIMARY_BOXED),
+ Imm = hipe_rtl:mk_imm(1*WordSize+Offset),
+ [Untag, hipe_rtl:mk_load(USize, Base, Imm)].
-spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer().
@@ -1040,7 +1091,7 @@ create_matchstate(Max, BinSize, Base, Offset, Orig, Ms) ->
SizeInWords = ((ByteSize div WordSize) - 1),
Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
[GetHPInsn,
- hipe_rtl:mk_alu(Ms, HP, add, hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ tag_boxed(Ms, HP),
set_field_from_term({matchstate,thing_word}, Ms, Header),
set_field_from_term({matchstate,{matchbuffer,orig}}, Ms, Orig),
set_field_from_term({matchstate,{matchbuffer,base}}, Ms, Base),
@@ -1078,7 +1129,10 @@ convert_matchstate(Ms) ->
size_from_header(SizeInWords, Header),
hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)),
mk_var_header(BigIntHeader, Hole, ?TAG_HEADER_POS_BIG),
- hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize-?TAG_PRIMARY_BOXED),
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is
+ %% fine here
+ hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize
+ -?TAG_PRIMARY_BOXED),
BigIntHeader)].
compare_matchstate(Max, Ms, LargeEnough, TooSmall) ->
@@ -1087,8 +1141,10 @@ compare_matchstate(Max, Ms, LargeEnough, TooSmall) ->
SizeInWords = ((ByteSize div WordSize) - 1),
Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
RealHeader = hipe_rtl:mk_new_reg_gcsafe(),
- [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)),
- hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)].
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine
+ %% here
+ [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
@@ -1207,15 +1263,22 @@ get_field_size1({matchbuffer, base}) ->
get_field_size1({matchbuffer, binsize}) ->
?MB_SIZE_SIZE.
+get_field_addr_from_term(Struct, Term, Dst) ->
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
+ [Untag, hipe_rtl:mk_alu(Dst, Base, add, Offset)].
+
get_field_from_term(Struct, Term, Dst) ->
- Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
Size = get_field_size(Struct),
- hipe_rtl:mk_load(Dst, Term, Offset, Size, unsigned).
+ [Untag, hipe_rtl:mk_load(Dst, Base, Offset, Size, unsigned)].
set_field_from_term(Struct, Term, Value) ->
- Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
Size = get_field_size(Struct),
- hipe_rtl:mk_store(Term, Offset, Value, Size).
+ [Untag, hipe_rtl:mk_store(Base, Offset, Value, Size)].
get_field_from_pointer(Struct, Term, Dst) ->
Offset = hipe_rtl:mk_imm(get_field_offset(Struct)),
@@ -1229,6 +1292,8 @@ set_field_from_pointer(Struct, Term, Value) ->
extract_matchbuffer(Mb, Ms) ->
What = {matchstate, matchbuffer},
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine
+ %% here
Offset = hipe_rtl:mk_imm(get_field_offset(What) - ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Mb, Ms, add, Offset).
diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc
index c7c1a8e1d7..29e8b92266 100644
--- a/lib/hipe/ssa/hipe_ssa.inc
+++ b/lib/hipe/ssa/hipe_ssa.inc
@@ -463,20 +463,20 @@ updateStatementDefs([], Statement, Current, Acc) ->
%%----------------------------------------------------------------------
updateIndices(Current, Variable) ->
- case ?CODE:is_var(Variable) of
- true ->
- NewVar = ?CODE:mk_new_var(),
- {NewVar,gb_trees:enter(Variable, NewVar, Current)};
- false ->
- case is_fp_temp(Variable) of
- true ->
- NewFVar = mk_new_fp_temp(),
- {NewFVar,gb_trees:enter(Variable, NewFVar, Current)};
- false ->
- NewReg = ?CODE:mk_new_reg(),
- {NewReg,gb_trees:enter(Variable, NewReg, Current)}
- end
- end.
+ New =
+ case ?CODE:is_var(Variable) of
+ true -> ?CODE:mk_new_var();
+ false ->
+ case is_fp_temp(Variable) of
+ true -> mk_new_fp_temp();
+ false ->
+ case ?CODE:reg_is_gcsafe(Variable) of
+ true -> ?CODE:mk_new_reg_gcsafe();
+ false -> ?CODE:mk_new_reg()
+ end
+ end
+ end,
+ {New, gb_trees:enter(Variable, New, Current)}.
%%----------------------------------------------------------------------
%% Procedure : updateSuccPhi/4
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
index 544888719f..efeb0887ab 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
MODULES= \
hipe_SUITE \
- opt_verify_SUITE
+ opt_verify_SUITE \
+ erl_types_SUITE
# .erl files for these modules are automatically generated
GEN_MODULES= \
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index 229a0516dc..ba9c03d4ba 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -6,12 +6,13 @@
%%%-------------------------------------------------------------------
-module(basic_exceptions).
--export([test/0, test_catches/0]).
+-export([test/0]).
%% functions used as arguments to spawn/3
-export([bad_guy/2]).
test() ->
+ ok = test_catches(),
ok = test_catch_exit(42),
ok = test_catch_throw(42),
ok = test_catch_element(),
@@ -22,6 +23,8 @@ test() ->
ok = test_pending_errors(),
ok = test_bad_fun_call(),
ok = test_guard_bif(),
+ ok = test_eclectic(),
+ ok = test_raise(),
ok.
%%--------------------------------------------------------------------
@@ -463,3 +466,213 @@ guard_bif('node/0', X, Y) when node() == Y ->
{'node/0', X, Y};
guard_bif('node/1', X, Y) when node(X) == Y ->
{'node/1', X, Y}.
+
+%%--------------------------------------------------------------------
+%% Taken from trycatch_SUITE.erl (compiler test suite).
+%%
+%% Cases that are commented out contain exception information that was
+%% added to Erlang/OTP in commit e8d45ae14c6c3bdfcbbc7964228b004ef4f11ea6
+%% (May 2017) only in the BEAM emulator. Thus, part of this test fails
+%% when compiled in native code.
+%% The remaining cases are uncommented so that they are properly tested
+%% in native code too.
+%%--------------------------------------------------------------------
+
+test_eclectic() ->
+ V = {make_ref(),3.1415926535,[[]|{}]},
+ {{value,{value,V},V},V} =
+ eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}),
+ {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} =
+ eclectic_1({catch_foo,{error,V}}, undefined, {value,V}),
+ {{error,{exit,V},{'EXIT',V}},V} =
+ eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
+ %% {{value,{value,V},V},
+ %% {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
+ %% eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
+ {{'EXIT',V},V} =
+ eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
+ %% {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
+ %% {'EXIT',V}} =
+ %% eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
+ {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
+ {'EXIT',V}} =
+ eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}),
+ %%
+ {{value,{value,{value,V},V}},V} =
+ eclectic_2({value,{value,V}}, undefined, {value,V}),
+ {{value,{throw,{value,V},V}},V} =
+ eclectic_2({throw,{value,V}}, throw, {value,V}),
+ {{caught,{'EXIT',V}},undefined} =
+ eclectic_2({value,{value,V}}, undefined, {exit,V}),
+ {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+ eclectic_2({error,{value,V}}, throw, {error,V}),
+ %% The following fails in native code
+ %% %% {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
+ %% %% eclectic_2({value,{'abs',V}}, undefined, {value,V}),
+ %% {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
+ %% eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
+ {{caught,{'EXIT',V}},undefined} =
+ eclectic_2({value,{error,V}}, undefined, {exit,V}),
+ {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+ eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}),
+ ok.
+
+eclectic_1(X, C, Y) ->
+ erase(eclectic),
+ Done = make_ref(),
+ Try =
+ try case X of
+ {catch_foo,V} -> catch {Done,foo(V)};
+ {foo,V} -> {Done,foo(V)}
+ end of
+ {Done,D} -> {value,D,catch foo(D)};
+ {'EXIT',_}=Exit -> Exit;
+ D -> {D,catch foo(D)}
+ catch
+ C:D -> {C,D,catch foo(D)}
+ after
+ put(eclectic, catch foo(Y))
+ end,
+ {Try,erase(eclectic)}.
+
+eclectic_2(X, C, Y) ->
+ Done = make_ref(),
+ erase(eclectic),
+ Catch =
+ case
+ catch
+ {Done,
+ try foo(X) of
+ V -> {value,V,foo(V)}
+ catch
+ C:D -> {C,D,foo(D)}
+ after
+ put(eclectic, foo(Y))
+ end} of
+ {Done,Z} -> {value,Z};
+ Z -> {caught,Z}
+ end,
+ {Catch,erase(eclectic)}.
+
+foo({value,Value}) -> Value;
+foo({'div',{A,B}}) ->
+ my_div(A, B);
+foo({'add',{A,B}}) ->
+ my_add(A, B);
+foo({'abs',X}) ->
+ my_abs(X);
+foo({error,Error}) ->
+ erlang:error(Error);
+foo({throw,Throw}) ->
+ erlang:throw(Throw);
+foo({exit,Exit}) ->
+ erlang:exit(Exit);
+foo({raise,{Class,Reason}}) ->
+ erlang:raise(Class, Reason);
+foo(Term) when not is_atom(Term) -> Term.
+%%foo(Atom) when is_atom(Atom) -> % must not be defined!
+
+my_div(A, B) ->
+ A div B.
+
+my_add(A, B) ->
+ A + B.
+
+my_abs(X) ->
+ abs(X).
+
+test_raise() ->
+ test_raise(fun() -> exit({exit,tuple}) end),
+ test_raise(fun() -> abs(id(x)) end),
+ test_raise(fun() -> throw({was,thrown}) end),
+
+ badarg = bad_raise(fun() -> abs(id(x)) end),
+
+ ok.
+
+bad_raise(Expr) ->
+ try
+ Expr()
+ catch
+ _:E:Stk ->
+ erlang:raise(bad_class, E, Stk)
+ end.
+
+test_raise(Expr) ->
+ test_raise_1(Expr),
+ test_raise_2(Expr),
+ test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_1(Expr)
+ catch
+ C:E:Stk ->
+ {C,E,Stk} = erase(exception)
+ end.
+
+do_test_raise_1(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here the stacktrace must be built.
+ put(exception, {C,E,Stk}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_2(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_2(Expr)
+ catch
+ C:E:Stk ->
+ {C,E} = erase(exception),
+ try
+ Expr()
+ catch
+ _:_:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_2(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ put(exception, {C,E}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_3(Expr) ->
+ try
+ do_test_raise_3(Expr)
+ catch
+ exit:{exception,C,E}:Stk ->
+ try
+ Expr()
+ catch
+ C:E:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_3(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ erlang:raise(exit, {exception,C,E}, Stk)
+ end.
+
+id(I) -> I.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
index e71045bfe2..fc87abb54e 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
@@ -8,8 +8,9 @@
-export([test/0]).
-%% functions that need to be exported so that they are retained.
--export([auth/4]).
+%% functions that need to be exported so that they are retained and/or
+%% not specialized away by the compiler.
+-export([auth/4, wxSizer_replace/2, parent_class/1]).
test() ->
ok = test_dominance_trees(),
@@ -18,6 +19,7 @@ test() ->
ok = test_bif_fails(),
ok = test_find_catches(),
ok = test_heap_allocate_trim(),
+ ok = wxSizer_replace(),
ok.
%%--------------------------------------------------------------------
@@ -151,3 +153,25 @@ get_next_retry(Error, Count) ->
end.
pair(A, B) -> {A, B}.
+
+%%--------------------------------------------------------------------
+%% Date: June 11, 2018
+%%
+%% Stripped down test case (from `wxSizer') that crashed the lazy code
+%% motion pass of the HiPE compiler in a pre-release of Erlang/OTP 21.
+%% A similar crash existed in `ssl_correction'.
+%%--------------------------------------------------------------------
+
+wxSizer_replace() ->
+ wxSizer_replace(?MODULE, ?MODULE).
+
+-define(CLASS(Type, Class), ((Type) =:= Class) orelse (Type):parent_class(Class)).
+
+wxSizer_replace(OldwinT, NewwinT) -> % this function was the culprit
+ ?CLASS(OldwinT, ?MODULE),
+ ?CLASS(NewwinT, ?MODULE),
+ ok.
+
+parent_class(wxWindow) -> true;
+parent_class(wxEvtHandler) -> true;
+parent_class(_Class) -> erlang:error({badtype, ?MODULE}).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
index 5f865d7b7a..20e3f350e8 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_receive.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
@@ -12,6 +12,7 @@ test() ->
ok = test_wait_timeout(),
ok = test_double_timeout(),
ok = test_reschedule(),
+ ok = test_recv_mark(),
ok.
%%--------------------------------------------------------------------
@@ -54,3 +55,91 @@ doit(First) ->
erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1).
%%--------------------------------------------------------------------
+%% Check that we cannot cause a recv_mark,recv_set pair to misbehave and
+%% deadlock the process.
+
+test_recv_mark() ->
+ ok = test_recv_mark(fun disturber_nop/0),
+ ok = test_recv_mark(fun disturber_receive/0),
+ ok = test_recv_mark(fun disturber_other/0),
+ ok = test_recv_mark(fun disturber_recurse/0),
+ ok = test_recv_mark_after(self(), fun disturber_after_recurse/0, false),
+ ok = test_recv_mark(fun disturber_other_recurse/0),
+ ok = test_recv_mark(fun disturber_other_after/0),
+ ok = test_recv_mark_nested().
+
+test_recv_mark(Disturber) ->
+ Ref = make_ref(),
+ self() ! Ref,
+ Disturber(),
+ receive Ref -> ok
+ after 0 -> error(failure)
+ end.
+
+disturber_nop() -> ok.
+
+disturber_receive() ->
+ self() ! message,
+ receive message -> ok end.
+
+disturber_other() ->
+ Ref = make_ref(),
+ self() ! Ref,
+ receive Ref -> ok end.
+
+disturber_recurse() ->
+ aborted = (catch test_recv_mark(fun() -> throw(aborted) end)),
+ ok.
+
+test_recv_mark_after(Recipient, Disturber, IsInner) ->
+ Ref = make_ref(),
+ Recipient ! Ref,
+ Disturber(),
+ receive
+ Ref -> ok
+ after 0 ->
+ case IsInner of
+ true -> expected;
+ false -> error(failure)
+ end
+ end.
+
+disturber_after_recurse() ->
+ NoOp = fun() -> ok end,
+ BlackHole = spawn(NoOp),
+ expected = test_recv_mark_after(BlackHole, NoOp, true),
+ ok.
+
+disturber_other_recurse() ->
+ aborted = (catch disturber_other_recurse(fun() -> throw(aborted) end)),
+ ok.
+
+disturber_other_recurse(InnerD) ->
+ Ref = make_ref(),
+ self() ! Ref,
+ InnerD(),
+ receive Ref -> ok
+ after 0 -> error(failure)
+ end.
+
+disturber_other_after() ->
+ BlackHole = spawn(fun() -> ok end),
+ Ref = make_ref(),
+ BlackHole ! Ref,
+ receive Ref -> error(imposible)
+ after 0 -> ok
+ end.
+
+test_recv_mark_nested() ->
+ Ref1 = make_ref(),
+ self() ! Ref1,
+ begin
+ Ref2 = make_ref(),
+ self() ! Ref2,
+ receive Ref2 -> ok end
+ end,
+ receive Ref1 -> ok
+ after 0 -> error(failure)
+ end.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/erl_types_SUITE.erl b/lib/hipe/test/erl_types_SUITE.erl
new file mode 100644
index 0000000000..7d7c144b69
--- /dev/null
+++ b/lib/hipe/test/erl_types_SUITE.erl
@@ -0,0 +1,197 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+-module(erl_types_SUITE).
+
+-export([all/0,
+ consistency_and_to_string/1]).
+
+%% Simplify calls into erl_types and avoid importing the entire module.
+-define(M, erl_types).
+
+-include_lib("common_test/include/ct.hrl").
+
+all() ->
+ [consistency_and_to_string].
+
+consistency_and_to_string(_Config) ->
+ %% Check consistency of types
+ Atom1 = ?M:t_atom(),
+ Atom2 = ?M:t_atom(foo),
+ Atom3 = ?M:t_atom(bar),
+ true = ?M:t_is_atom(Atom2),
+
+ True = ?M:t_atom(true),
+ False = ?M:t_atom(false),
+ Bool = ?M:t_boolean(),
+ true = ?M:t_is_boolean(True),
+ true = ?M:t_is_boolean(Bool),
+ false = ?M:t_is_boolean(Atom1),
+
+ Binary = ?M:t_binary(),
+ true = ?M:t_is_binary(Binary),
+
+ Bitstr = ?M:t_bitstr(),
+ true = ?M:t_is_bitstr(Bitstr),
+
+ Bitstr1 = ?M:t_bitstr(7, 3),
+ true = ?M:t_is_bitstr(Bitstr1),
+ false = ?M:t_is_binary(Bitstr1),
+
+ Bitstr2 = ?M:t_bitstr(16, 8),
+ true = ?M:t_is_bitstr(Bitstr2),
+ true = ?M:t_is_binary(Bitstr2),
+
+ BitStr816 = ?M:t_bitstr(8,16),
+ BitStr816 = ?M:t_subtract(?M:t_bitstr(4, 12), ?M:t_bitstr(8, 12)),
+
+ Int1 = ?M:t_integer(),
+ Int2 = ?M:t_integer(1),
+ Int3 = ?M:t_integer(16#ffffffff),
+ true = ?M:t_is_integer(Int2),
+ true = ?M:t_is_byte(Int2),
+ false = ?M:t_is_byte(Int3),
+ false = ?M:t_is_byte(?M:t_from_range(-1, 1)),
+ true = ?M:t_is_byte(?M:t_from_range(1, 255)),
+
+ Tuple1 = ?M:t_tuple(),
+ Tuple2 = ?M:t_tuple(3),
+ Tuple3 = ?M:t_tuple([Atom1, Int1]),
+ Tuple4 = ?M:t_tuple([Tuple1, Tuple2]),
+ Tuple5 = ?M:t_tuple([Tuple3, Tuple4]),
+ Tuple6 = ?M:t_limit(Tuple5, 2),
+ Tuple7 = ?M:t_limit(Tuple5, 3),
+ true = ?M:t_is_tuple(Tuple1),
+
+ Port = ?M:t_port(),
+ Pid = ?M:t_pid(),
+ Ref = ?M:t_reference(),
+ Identifier = ?M:t_identifier(),
+ false = ?M:t_is_reference(Port),
+ true = ?M:t_is_identifier(Port),
+
+ Function1 = ?M:t_fun(),
+ Function2 = ?M:t_fun(Pid),
+ Function3 = ?M:t_fun([], Pid),
+ Function4 = ?M:t_fun([Port, Pid], Pid),
+ Function5 = ?M:t_fun([Pid, Atom1], Int2),
+ true = ?M:t_is_fun(Function3),
+
+ List1 = ?M:t_list(),
+ List2 = ?M:t_list(?M:t_boolean()),
+ List3 = ?M:t_cons(?M:t_boolean(), List2),
+ List4 = ?M:t_cons(?M:t_boolean(), ?M:t_atom()),
+ List5 = ?M:t_cons(?M:t_boolean(), ?M:t_nil()),
+ List6 = ?M:t_cons_tl(List5),
+ List7 = ?M:t_sup(List4, List5),
+ List8 = ?M:t_inf(List7, ?M:t_list()),
+ List9 = ?M:t_cons(),
+ List10 = ?M:t_cons_tl(List9),
+ true = ?M:t_is_boolean(?M:t_cons_hd(List5)),
+ true = ?M:t_is_list(List5),
+ false = ?M:t_is_list(List4),
+
+ Product1 = ?M:t_product([Atom1, Atom2]),
+ Product2 = ?M:t_product([Atom3, Atom1]),
+ Product3 = ?M:t_product([Atom3, Atom2]),
+
+ Union1 = ?M:t_sup(Atom2, Atom3),
+ Union2 = ?M:t_sup(Tuple2, Tuple3),
+ Union3 = ?M:t_sup(Int2, Atom3),
+ Union4 = ?M:t_sup(Port, Pid),
+ Union5 = ?M:t_sup(Union4, Int1),
+ Union6 = ?M:t_sup(Function1, Function2),
+ Union7 = ?M:t_sup(Function4, Function5),
+ Union8 = ?M:t_sup(True, False),
+ true = ?M:t_is_boolean(Union8),
+ Union9 = ?M:t_sup(Int2, ?M:t_integer(2)),
+ true = ?M:t_is_byte(Union9),
+ Union10 = ?M:t_sup(?M:t_tuple([?M:t_atom(true), ?M:t_any()]),
+ ?M:t_tuple([?M:t_atom(false), ?M:t_any()])),
+
+ Any = ?M:t_any(),
+ Any = ?M:t_sup(Product3, Function5),
+
+ Atom3 = ?M:t_inf(Union3, Atom1),
+ Union2 = ?M:t_inf(Union2, Tuple1),
+ Int2 = ?M:t_inf(Int1, Union3),
+ Union4 = ?M:t_inf(Union4, Identifier),
+ Port = ?M:t_inf(Union5, Port),
+ Function4 = ?M:t_inf(Union7, Function4),
+ None = ?M:t_none(),
+ None = ?M:t_inf(Product2, Atom1),
+ Product3 = ?M:t_inf(Product1, Product2),
+ Function5 = ?M:t_inf(Union7, Function5),
+ true = ?M:t_is_byte(?M:t_inf(Union9, ?M:t_number())),
+ true = ?M:t_is_char(?M:t_inf(Union9, ?M:t_number())),
+
+ RecDict = #{{record, foo} => {{?FILE, ?LINE}, [{2, [{bar, [], ?M:t_any()},
+ {baz, [], ?M:t_any()}]}]}},
+ Record1 = ?M:t_from_term({foo, [1,2], {1,2,3}}),
+
+ %% Check string representations
+ "atom()" = ?M:t_to_string(Atom1),
+ "'foo'" = ?M:t_to_string(Atom2),
+ "'bar'" = ?M:t_to_string(Atom3),
+
+ "binary()" = ?M:t_to_string(Binary),
+
+ "integer()" = ?M:t_to_string(Int1),
+ "1" = ?M:t_to_string(Int2),
+
+ "tuple()" = ?M:t_to_string(Tuple1),
+ "{_,_,_}" = ?M:t_to_string(Tuple2),
+ "{atom(),integer()}" = ?M:t_to_string(Tuple3),
+ "{tuple(),{_,_,_}}" = ?M:t_to_string(Tuple4),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple5),
+ "{{_,_},{_,_}}" = ?M:t_to_string(Tuple6),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple7),
+
+ "reference()" = ?M:t_to_string(Ref),
+ "port()" = ?M:t_to_string(Port),
+ "pid()" = ?M:t_to_string(Pid),
+ "identifier()" = ?M:t_to_string(Identifier),
+
+ "[any()]" = ?M:t_to_string(List1),
+ "[boolean()]" = ?M:t_to_string(List2),
+ "[boolean(),...]" = ?M:t_to_string(List3),
+ "nonempty_improper_list(boolean(),atom())" = ?M:t_to_string(List4),
+ "[boolean(),...]" = ?M:t_to_string(List5),
+ "[boolean()]" = ?M:t_to_string(List6),
+ "nonempty_maybe_improper_list(boolean(),atom() | [])" = ?M:t_to_string(List7),
+ "[boolean(),...]" = ?M:t_to_string(List8),
+ "nonempty_maybe_improper_list()" = ?M:t_to_string(List9),
+ "any()" = ?M:t_to_string(List10),
+
+ "fun()" = ?M:t_to_string(Function1),
+ "fun((...) -> pid())" = ?M:t_to_string(Function2),
+ "fun(() -> pid())" = ?M:t_to_string(Function3),
+ "fun((port(),pid()) -> pid())" = ?M:t_to_string(Function4),
+ "fun((pid(),atom()) -> 1)" = ?M:t_to_string(Function5),
+
+ "<atom(),'foo'>" = ?M:t_to_string(Product1),
+ "<'bar',atom()>" = ?M:t_to_string(Product2),
+
+ "#foo{bar::[1 | 2,...],baz::{1,2,3}}" = ?M:t_to_string(Record1, RecDict),
+
+ "'bar' | 'foo'" = ?M:t_to_string(Union1),
+ "{atom(),integer()} | {_,_,_}" = ?M:t_to_string(Union2),
+ "'bar' | 1" = ?M:t_to_string(Union3),
+ "pid() | port()" = ?M:t_to_string(Union4),
+ "pid() | port() | integer()" = ?M:t_to_string(Union5),
+ "fun()" = ?M:t_to_string(Union6),
+ "fun((pid() | port(),atom() | pid()) -> pid() | 1)" = ?M:t_to_string(Union7),
+ "boolean()" = ?M:t_to_string(Union8),
+ "{'false',_} | {'true',_}" = ?M:t_to_string(Union10),
+ "{'true',integer()}" = ?M:t_to_string(?M:t_inf(Union10, ?M:t_tuple([?M:t_atom(true), ?M:t_integer()]))).
diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl
index 88576775ca..8813af5dfc 100644
--- a/lib/hipe/test/hipe_testsuite_driver.erl
+++ b/lib/hipe/test/hipe_testsuite_driver.erl
@@ -29,13 +29,9 @@ get_suites(SuitesWithSuiteSuffix) ->
[S || {yes, S} <- Prefixes].
suffix(String, Suffix) ->
- case string:rstr(String, Suffix) of
- 0 -> no;
- Index ->
- case string:substr(String, Index) =:= Suffix of
- true -> {yes, string:sub_string(String, 1, Index-1)};
- false -> no
- end
+ case string:split(String, Suffix, trailing) of
+ [Prefix,[]] -> {yes, Prefix};
+ _ -> no
end.
-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}.
@@ -165,7 +161,8 @@ run(TestCase, Dir, _OutDir) ->
%% end, DataFiles),
%% try
ok = TestCase:test(),
- HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end,
+ HiPEOpts0 = try TestCase:hipe_options() catch error:undef -> [] end,
+ HiPEOpts = HiPEOpts0 ++ hipe_options(),
{ok, TestCase} = hipe:c(TestCase, HiPEOpts),
ok = TestCase:test(),
{ok, TestCase} = hipe:c(TestCase, [o1|HiPEOpts]),
@@ -183,3 +180,6 @@ run(TestCase, Dir, _OutDir) ->
%% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end,
%% [filename:join(OutDir, D) || D <- DataFiles])
%% end.
+
+hipe_options() ->
+ [verify_gcsafe].
diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl
index a323c10503..24f43af275 100644
--- a/lib/hipe/test/opt_verify_SUITE.erl
+++ b/lib/hipe/test/opt_verify_SUITE.erl
@@ -59,7 +59,7 @@ call_elim_test_file(Config, FileName, Option) ->
substring_count(Icode, Substring) ->
substring_count(Icode, Substring, 0).
substring_count(Icode, Substring, N) ->
- case string:str(Icode, Substring) of
- 0 -> N;
- I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
+ case string:find(Icode, Substring) of
+ nomatch -> N;
+ Prefix -> substring_count(string:prefix(Prefix, Substring), Substring, N+1)
end.
diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk
index 0c517f9a7a..b081cb0c26 100644
--- a/lib/hipe/vsn.mk
+++ b/lib/hipe/vsn.mk
@@ -1 +1 @@
-HIPE_VSN = 3.17.1
+HIPE_VSN = 3.18
diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl
index 31e4f6e4ac..22947da148 100644
--- a/lib/hipe/x86/hipe_rtl_to_x86.erl
+++ b/lib/hipe/x86/hipe_rtl_to_x86.erl
@@ -646,7 +646,7 @@ conv_imm(Opnd, Map) ->
is_imm64(Value) when is_integer(Value) ->
(Value < -(1 bsl (32 - 1))) or (Value > (1 bsl (32 - 1)) - 1);
is_imm64({_,atom}) -> false; % Atoms are 32 bits.
-is_imm64({_,c_const}) -> false; % c_consts are 32 bits.
+is_imm64({_,c_const}) -> true; % c_consts are 64 bits.
is_imm64({_,_}) -> true . % Other relocs are 64 bits.
-else.
conv_imm(Opnd, Map) ->
@@ -777,6 +777,18 @@ conv_fconv(Dst, Src) ->
%%% Finalise the conversion of a 2-address FP operation.
+-ifdef(HIPE_AMD64).
+conv_fp_unary(Dst, Src, 'fchs') ->
+ Tmp = new_untagged_temp(),
+ case same_opnd(Dst, Src) of
+ true ->
+ [];
+ _ ->
+ [hipe_x86:mk_fmove(Src, Dst)]
+ end ++
+ mk_load_address(c_const, hipe_x86:mk_imm({sse2_fnegate_mask, c_const}), Tmp) ++
+ [hipe_x86:mk_fp_binop('xorpd', hipe_x86:mk_mem(Tmp, hipe_x86:mk_imm(0), double), Dst)].
+-else.
conv_fp_unary(Dst, Src, FpUnOp) ->
case same_opnd(Dst, Src) of
true ->
@@ -785,6 +797,7 @@ conv_fp_unary(Dst, Src, FpUnOp) ->
[hipe_x86:mk_fmove(Src, Dst),
hipe_x86:mk_fp_unop(FpUnOp, Dst)]
end.
+-endif.
conv_fp_unop(RtlFpUnOp) ->
case RtlFpUnOp of
@@ -854,13 +867,8 @@ mk_jmp_switch(Index, JTabLab, Labels) ->
%%% Finalise the translation of a load_address instruction.
-ifdef(HIPE_AMD64).
-mk_load_address(Type, Src, Dst) ->
- case Type of
- c_const -> % 32 bits
- [hipe_x86:mk_move(Src, Dst)];
- _ ->
- [hipe_x86:mk_move64(Src, Dst)]
- end.
+mk_load_address(_Type, Src, Dst) ->
+ [hipe_x86:mk_move64(Src, Dst)].
-else.
mk_load_address(_Type, Src, Dst) ->
[hipe_x86:mk_move(Src, Dst)].
diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl
index 50919bdf4e..9d2586a14d 100644
--- a/lib/hipe/x86/hipe_x86_assemble.erl
+++ b/lib/hipe/x86/hipe_x86_assemble.erl
@@ -735,6 +735,7 @@ resolve_sse2_op(Op) ->
fdiv -> divsd;
fmul -> mulsd;
fsub -> subsd;
+ xorpd -> xorpd;
_ -> exit({?MODULE, unknown_sse2_operator, Op})
end.