aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_disasm.erl3
-rw-r--r--lib/compiler/src/beam_record.erl106
-rw-r--r--lib/compiler/src/beam_type.erl44
-rw-r--r--lib/compiler/src/beam_validator.erl3
-rw-r--r--lib/compiler/src/compile.erl19
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/core_scan.erl8
-rwxr-xr-xlib/compiler/src/genop.tab6
-rw-r--r--lib/compiler/test/Makefile1
-rw-r--r--lib/compiler/test/compile_SUITE.erl69
-rw-r--r--lib/compiler/test/misc_SUITE.erl17
12 files changed, 254 insertions, 24 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index cf60355a40..59b80ade5d 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -63,6 +63,7 @@ MODULES = \
beam_peep \
beam_receive \
beam_reorder \
+ beam_record \
beam_split \
beam_trim \
beam_type \
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c699672db1..8fd0b36d05 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -815,6 +815,9 @@ resolve_inst({is_tuple=I,Args0},_,_,_) ->
resolve_inst({test_arity=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
+resolve_inst({is_tagged_tuple=I,Args0},_,_,_) ->
+ [F|Args] = resolve_args(Args0),
+ {test,I,F,Args};
resolve_inst({select_val,Args},_,_,_) ->
[Reg,FLbl,{{z,1},{u,_Len},List0}] = Args,
List = resolve_args(List0),
diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl
new file mode 100644
index 0000000000..419089b1bc
--- /dev/null
+++ b/lib/compiler/src/beam_record.erl
@@ -0,0 +1,106 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2017. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% File: beam_record.erl
+%% Author: Björn-Egil Dahlberg
+%% Created: 2014-09-03
+%%
+
+-module(beam_record).
+-export([module/2]).
+
+%% Rewrite the instruction stream on tagged tuple tests.
+%% Tagged tuples means a tuple of any arity with an atom as its first element.
+%% Typically records, ok-tuples and error-tuples.
+%%
+%% from:
+%% ...
+%% {test,is_tuple,Fail,[Src]}.
+%% {test,test_arity,Fail,[Src,Sz]}.
+%% ...
+%% {get_tuple_element,Src,0,Dst}.
+%% ...
+%% {test,is_eq_exact,Fail,[Dst,Atom]}.
+%% ...
+%% to:
+%% ...
+%% {test,is_tagged_tuple,Fail,[Src,Sz,Atom]}.
+%% ...
+
+
+-import(lists, [reverse/1]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is}) ->
+ try
+ Idx = beam_utils:index_labels(Is),
+ {function,Name,Arity,CLabel,rewrite(Is,Idx)}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+rewrite(Is,Idx) ->
+ rewrite(Is,Idx,[]).
+
+rewrite([{test,is_tuple,Fail,[Src]}=I1,
+ {test,test_arity,Fail,[Src,N]}=I2|Is],Idx,Acc) ->
+ case is_tagged_tuple(Is,Fail,Src,Idx) of
+ no ->
+ rewrite(Is,Idx,[I2,I1|Acc]);
+ {Atom,[{block,[]}|Is1]} ->
+ rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc]);
+ {Atom,Is1} ->
+ rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc])
+ end;
+rewrite([I|Is],Idx,Acc) ->
+ rewrite(Is,Idx,[I|Acc]);
+rewrite([],_,Acc) -> reverse(Acc).
+
+is_tagged_tuple([{block,[{set,[Dst],[Src],{get_tuple_element,0}}=B|Bs]},
+ {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is],Fail,Src,Idx) ->
+
+ %% if Dst is killed in the instruction stream and at fail label,
+ %% we can safely remove get_tuple_element.
+ %%
+ %% if Dst is not killed in the stream, we cannot remove get_tuple_element
+ %% since it is referenced.
+
+ case is_killed(Dst,Is,Fail,Idx) of
+ true -> {Atom,[{block,Bs}|Is]};
+ false -> {Atom,[{block,[B|Bs]}|Is]}
+ end;
+is_tagged_tuple([{block,[{set,_,_,_}=B|Bs]},
+ {test,is_eq_exact,_,_}=I|Is],Fail,Src,Idx) ->
+ case is_tagged_tuple([{block,Bs},I|Is],Fail,Src,Idx) of
+ {Atom,[{block,Bsr}|Isr]} -> {Atom,[{block,[B|Bsr]}|Isr]};
+ no -> no
+ end;
+is_tagged_tuple(_Is,_Fail,_Src,_Idx) ->
+ no.
+
+is_killed(Dst,Is,{_,Lbl},Idx) ->
+ beam_utils:is_killed(Dst,Is,Idx) andalso
+ beam_utils:is_killed_at(Dst,Lbl,Idx).
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 2b5d558ee4..7e9a243ada 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -26,6 +26,8 @@
-import(lists, [filter/2,foldl/3,keyfind/3,member/2,
reverse/1,reverse/2,sort/1]).
+-define(UNICODE_INT, {integer,{0,16#10FFFF}}).
+
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
@@ -494,6 +496,10 @@ update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
update({test,is_map,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,map}], Ts0);
+update({get_map_elements,_,Src,{list,Elems0}}, Ts0) ->
+ {_Ss,Ds} = beam_utils:split_even(Elems0),
+ Elems = [{Dst,kill} || Dst <- Ds],
+ tdb_update([{Src,map}|Elems], Ts0);
update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,nonempty_list}], Ts0);
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
@@ -507,10 +513,39 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
end;
update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) ->
tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts);
-update({test,_Test,_Fail,_Other}, Ts) ->
- Ts;
+
+%% Binary matching
+
update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
tdb_update([{Dst,get_bs_integer_type(Args)}], Ts);
+update({test,bs_get_utf8,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({test,bs_get_utf16,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({test,bs_get_utf32,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({bs_init,_,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({bs_put,_,_,_}, Ts) ->
+ Ts;
+update({bs_save2,_,_}, Ts) ->
+ Ts;
+update({bs_restore2,_,_}, Ts) ->
+ Ts;
+update({bs_context_to_binary,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_start_match2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_get_binary2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_get_float2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,float}], Ts);
+
+update({test,_Test,_Fail,_Other}, Ts) ->
+ Ts;
+
+%% Calls
+
update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
case is_math_bif(Math, Ar) of
true -> tdb_update([{{x,0},float}], Ts);
@@ -537,9 +572,10 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts);
+update({call_fun, _}, Ts) -> tdb_kill_xregs(Ts);
+update({apply, _}, Ts) -> tdb_kill_xregs(Ts);
+
update({line,_}, Ts) -> Ts;
-update({bs_save2,_,_}, Ts) -> Ts;
-update({bs_restore2,_,_}, Ts) -> Ts;
%% The instruction is unknown. Kill all information.
update(_I, _Ts) -> tdb_new().
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index bf33ae0aeb..c26e5719aa 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -653,6 +653,9 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
assert_type(tuple, Tuple, Vst),
set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst));
+valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) ->
+ validate_src([Src], Vst),
+ set_type_reg({tuple, Sz}, Src, branch_state(Lbl, Vst));
valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
assert_type(map, Src, Vst),
assert_unique_map_keys(List),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c849306c0d..019d8ba864 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -213,22 +213,14 @@ expand_opt(report, Os) ->
[report_errors,report_warnings|Os];
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
-expand_opt(r12, Os) ->
- [no_recv_opt,no_line_info,no_utf8_atoms|Os];
-expand_opt(r13, Os) ->
- [no_recv_opt,no_line_info,no_utf8_atoms|Os];
-expand_opt(r14, Os) ->
- [no_line_info,no_utf8_atoms|Os];
-expand_opt(r15, Os) ->
- [no_utf8_atoms|Os];
expand_opt(r16, Os) ->
- [no_utf8_atoms|Os];
+ [no_record_opt,no_utf8_atoms|Os];
expand_opt(r17, Os) ->
- [no_utf8_atoms|Os];
+ [no_record_opt,no_utf8_atoms|Os];
expand_opt(r18, Os) ->
- [no_utf8_atoms|Os];
+ [no_record_opt,no_utf8_atoms|Os];
expand_opt(r19, Os) ->
- [no_utf8_atoms|Os];
+ [no_record_opt,no_utf8_atoms|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_float_opt, Os) ->
@@ -755,6 +747,8 @@ asm_passes() ->
{iff,dbsm,{listing,"bsm"}},
{unless,no_recv_opt,{pass,beam_receive}},
{iff,drecv,{listing,"recv"}},
+ {unless,no_record_opt,{pass,beam_record}},
+ {iff,drecord,{listing,"record"}},
{unless,no_stack_trimming,{pass,beam_trim}},
{iff,dtrim,{listing,"trim"}},
{pass,beam_flatten}]},
@@ -1849,6 +1843,7 @@ pre_load() ->
beam_opcodes,
beam_peep,
beam_receive,
+ beam_record,
beam_reorder,
beam_split,
beam_trim,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 3cb991687b..3961b2af86 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -38,6 +38,7 @@
beam_peep,
beam_receive,
beam_reorder,
+ beam_record,
beam_split,
beam_trim,
beam_type,
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index 15bfc78c8b..d7d5f900de 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -283,10 +283,12 @@ scan1([$$|Cs0], Toks, Pos) -> %Character constant
scan1(Cs, [{char,Pos,C}|Toks], Pos1);
scan1([$'|Cs0], Toks, Pos) -> %Atom (always quoted)
{S,Cs1,Pos1} = scan_string(Cs0, $', Pos),
- case catch list_to_atom(S) of
+ try binary_to_atom(list_to_binary(S), utf8) of
A when is_atom(A) ->
- scan1(Cs1, [{atom,Pos,A}|Toks], Pos1);
- _Error -> scan_error({illegal,atom}, Pos)
+ scan1(Cs1, [{atom,Pos,A}|Toks], Pos1)
+ catch
+ error:_ ->
+ scan_error({illegal,atom}, Pos)
end;
scan1([$"|Cs0], Toks, Pos) -> %String
{S,Cs1,Pos1} = scan_string(Cs0, $", Pos),
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index dcbdeb32e6..5e0c2b3ebf 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -537,3 +537,9 @@ BEAM_FORMAT_NUMBER=0
156: is_map/2
157: has_map_fields/3
158: get_map_elements/3
+
+## @spec is_tagged_tuple Lbl Reg N Atom
+## @doc Test the type of Reg and jumps to Lbl if it is not a tuple.
+## Test the arity of Reg and jumps to Lbl if it is not N.
+## Test the first element of the tuple and jumps to Lbl if it is not Atom.
+159: is_tagged_tuple/4
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index e338dbb4e3..63763f31b2 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -185,6 +185,7 @@ release_tests_spec: make_emakefile
echo "-module($$module). %% dummy .erl file" >$$file; \
done
$(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)"
+ rm $(ERL_DUMMY_FILES)
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 10740ac2b0..474c3e2ca0 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -865,9 +865,7 @@ do_core_roundtrip_2(M, Core0, Outdir) ->
case cmp_core(Core0, Core, M) of
true -> ok;
false -> error
- end,
-
- ok.
+ end.
undo_var_translation(Tree) ->
F = fun(Node) ->
@@ -920,11 +918,72 @@ diff(E, E) ->
diff([H1|T1], [H2|T2]) ->
[diff(H1, H2)|diff(T1, T2)];
diff(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
- L = diff(tuple_to_list(T1), tuple_to_list(T2)),
- list_to_tuple(L);
+ case cerl:is_c_var(T1) andalso cerl:is_c_var(T2) of
+ true ->
+ diff_var(T1, T2);
+ false ->
+ case cerl:is_c_map(T1) andalso cerl:is_c_map(T2) of
+ true ->
+ diff_map(T1, T2);
+ false ->
+ diff_tuple(T1, T2)
+ end
+ end;
diff(E1, E2) ->
{'DIFF',E1,E2}.
+diff_var(V1, V2) ->
+ case {cerl:var_name(V1),cerl:var_name(V2)} of
+ {Same,Same} ->
+ V1;
+ {Name1,Name2} ->
+ %% The inliner uses integers as variable names. Such integers
+ %% are read back as atoms.
+ case is_integer(Name1) andalso
+ list_to_atom(integer_to_list(Name1)) =:= Name2 of
+ true ->
+ V1;
+ _ ->
+ cerl:update_c_var(V1, {'DIFF',Name1,Name2})
+ end
+ end.
+
+%% Annotations for maps are not preserved exactly, but that is not
+%% a real problem. Workaround by not comparing all annotations when
+%% comparing maps.
+
+diff_map(M, M) ->
+ M;
+diff_map(M1, M2) ->
+ case cerl:get_ann(M1) =:= cerl:get_ann(M2) of
+ false ->
+ diff_tuple(M1, M2);
+ true ->
+ case remove_compiler_gen(M1) =:= remove_compiler_gen(M2) of
+ true ->
+ M1;
+ false ->
+ diff_tuple(M1, M2)
+ end
+ end.
+
+diff_tuple(T1, T2) ->
+ L = diff(tuple_to_list(T1), tuple_to_list(T2)),
+ list_to_tuple(L).
+
+remove_compiler_gen(M) ->
+ Arg0 = cerl:map_arg(M),
+ Arg = cerl:set_ann(Arg0, []),
+ Es0 = cerl:map_es(M),
+ Es = [remove_compiler_gen_1(Pair) || Pair <- Es0],
+ cerl:update_c_map(M, Arg, Es).
+
+remove_compiler_gen_1(Pair) ->
+ Op0 = cerl:map_pair_op(Pair),
+ Op = cerl:set_ann(Op0, []),
+ K = cerl:map_pair_key(Pair),
+ V = cerl:map_pair_val(Pair),
+ cerl:update_c_map_pair(Pair, Op, K, V).
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 621524114f..fa6d5ee957 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -280,6 +280,23 @@ silly_coverage(Config) when is_list(Config) ->
{block,[a|b]}]}],0},
expect_error(fun() -> beam_receive:module(ReceiveInput, []) end),
+ %% beam_record.
+ RecordInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,1,2,
+ [{label,1},
+ {func_info,{atom,?MODULE},{atom,foo},1},
+ {label,2},
+ {test,is_tuple,{f,1},[{x,0}]},
+ {test,test_arity,{f,1},[{x,0},3]},
+ {block,[{set,[{x,1}],[{x,0}],{get_tuple_element,0}}]},
+ {test,is_eq_exact,{f,1},[{x,1},{atom,bar}]},
+ {block,[{set,[{x,2}],[{x,0}],{get_tuple_element,1}}|a]},
+ {test,is_eq_exact,{f,1},[{x,2},{integer,1}]},
+ {block,[{set,[{x,0}],[{atom,ok}],move}]},
+ return]}],0},
+
+ expect_error(fun() -> beam_record:module(RecordInput, []) end),
+
BeamZInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
[{label,1},
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-28 11:03:03 +0000