From 14d709b0e07e899161a40bb43fc43fd6916f59ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 29 Aug 2014 18:27:45 +0200 Subject: compiler: Add is_tagged_tuple instruction 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]}. ... --- erts/emulator/beam/beam_emu.c | 9 +++ erts/emulator/beam/ops.tab | 14 +++++ lib/compiler/src/Makefile | 1 + lib/compiler/src/beam_disasm.erl | 3 + lib/compiler/src/beam_record.erl | 106 ++++++++++++++++++++++++++++++++++++ lib/compiler/src/beam_validator.erl | 3 + lib/compiler/src/compile.erl | 17 +++--- lib/compiler/src/compiler.app.src | 1 + lib/compiler/src/genop.tab | 6 ++ 9 files changed, 153 insertions(+), 7 deletions(-) create mode 100644 lib/compiler/src/beam_record.erl diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 8be0f58227..9a91fdce08 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -850,6 +850,15 @@ do { \ } while (0) #endif +#define IsTaggedTuple(Src,Arityval,Tag,Fail) \ + do { \ + if (!(is_tuple(Src) && \ + (tuple_val(Src))[0] == Arityval && \ + (tuple_val(Src))[1] == Tag)) { \ + Fail; \ + } \ + } while (0) + #define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; } #define IsBinary(Src, Fail) \ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index ec36b23059..9b5bd7a749 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -620,6 +620,20 @@ test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y %macro: test_heap_1_put_list TestHeapPutList -pack test_heap_1_put_list I y +# +# is_tagged_tuple Fail=f Src=rxy Arity Atom=a +# + +is_tagged_tuple Fail Literal=q Arity Atom => \ + move Literal x | is_tagged_tuple Fail x Arity Atom +is_tagged_tuple Fail=f c Arity Atom => jump Fail + +%macro:is_tagged_tuple IsTaggedTuple -fail_action + +is_tagged_tuple f r A a +is_tagged_tuple f x A a +is_tagged_tuple f y A a + # Test tuple & arity (head) is_tuple Fail Literal=q => move Literal x | is_tuple Fail x 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_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..03b52932d1 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -216,19 +216,19 @@ expand_opt(return, 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]; + [no_record_opt,no_recv_opt,no_line_info,no_utf8_atoms|Os]; expand_opt(r14, Os) -> - [no_line_info,no_utf8_atoms|Os]; + [no_record_opt,no_line_info,no_utf8_atoms|Os]; expand_opt(r15, Os) -> - [no_utf8_atoms|Os]; + [no_record_opt,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 +755,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 +1851,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/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 -- cgit v1.2.3