aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2016-09-29 12:17:58 +0200
committerBjörn Gustavsson <[email protected]>2016-09-29 12:17:58 +0200
commit3651c6bb09319bd4e87892dc9ae0e6620a5a3e8d (patch)
treed1e312ba372e578f8adb0be5c98281df68c61abb
parent81082ce34fcaa97b0ef66a5e445fdbf2e3b9644c (diff)
parent05130e485558919344584f9bbfa057efdca94c3d (diff)
downloadotp-3651c6bb09319bd4e87892dc9ae0e6620a5a3e8d.tar.gz
otp-3651c6bb09319bd4e87892dc9ae0e6620a5a3e8d.tar.bz2
otp-3651c6bb09319bd4e87892dc9ae0e6620a5a3e8d.zip
Merge branch 'bjorn/compiler/misc'
* bjorn/compiler/misc: sys_core_fold: Run optimizations to a fixpoint sys_core_fold: Improve case optimization sys_core_fold: Correct scope verification code core_pp: Correct printing of map updates Simplify handling of internal BIFs v3_life: Eliminate special handling of guards Simplify beam_utils bs_match_SUITE: Add a test case for beam_utils bif_SUITE: Cover the remaining uncovered lines erl_bifs: Remove error_logger:warning_map/0 as a safe BIF beam_validator: Correct reporting of y register number beam_jump: Don't try to handle a label at the very end beam_jump: Simplify eliminate_fallthroughs/2 beam_listing: Remove support for listing sys_pre_expand format
-rw-r--r--lib/compiler/src/beam_jump.erl15
-rw-r--r--lib/compiler/src/beam_listing.erl4
-rw-r--r--lib/compiler/src/beam_trim.erl2
-rw-r--r--lib/compiler/src/beam_utils.erl278
-rw-r--r--lib/compiler/src/beam_validator.erl2
-rw-r--r--lib/compiler/src/core_pp.erl2
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rw-r--r--lib/compiler/src/sys_core_fold.erl155
-rw-r--r--lib/compiler/src/v3_codegen.erl30
-rw-r--r--lib/compiler/src/v3_kernel.erl14
-rw-r--r--lib/compiler/src/v3_kernel.hrl1
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl9
-rw-r--r--lib/compiler/src/v3_life.erl53
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl6
-rw-r--r--lib/compiler/test/bif_SUITE.erl20
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl25
16 files changed, 311 insertions, 306 deletions
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 48b5a32814..5311ce7379 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -155,9 +155,7 @@ share(Is0) ->
Is = eliminate_fallthroughs(Is0, []),
share_1(Is, #{}, [], []).
-share_1([{label,_}=Lbl|Is], Dict, [], Acc) ->
- share_1(Is, Dict, [], [Lbl|Acc]);
-share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
error ->
Dict = maps:put(Seq, L, Dict0),
@@ -208,21 +206,18 @@ sharable_with_try([]) -> true.
%% Eliminate all fallthroughs. Return the result reversed.
-eliminate_fallthroughs([I,{label,L}=Lbl|Is], Acc) ->
- case is_unreachable_after(I) orelse is_label(I) of
+eliminate_fallthroughs([{label,L}=Lbl|Is], [I|_]=Acc) ->
+ case is_unreachable_after(I) of
false ->
%% Eliminate fallthrough.
- eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}},I|Acc]);
+ eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}}|Acc]);
true ->
- eliminate_fallthroughs(Is, [Lbl,I|Acc])
+ eliminate_fallthroughs(Is, [Lbl|Acc])
end;
eliminate_fallthroughs([I|Is], Acc) ->
eliminate_fallthroughs(Is, [I|Acc]);
eliminate_fallthroughs([], Acc) -> Acc.
-is_label({label,_}) -> true;
-is_label(_) -> false.
-
%%%
%%% (2) Move short code sequences ending in an instruction that causes an exit
%%% to the end of the function.
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index ce566373bb..d82ed8639d 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -49,10 +49,6 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
[Name, Arity, Entry]),
io:put_chars(Stream, format_asm(Asm))
end, Code);
-module(Stream, {Mod,Exp,Inter}) ->
- %% Other kinds of intermediate formats.
- io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]),
- foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Inter);
module(Stream, [_|_]=Fs) ->
%% Form-based abstract format.
foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs).
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index a8dc6805bc..d40669083e 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -230,7 +230,7 @@ safe_labels([], Acc) -> gb_sets:from_list(Acc).
frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) ->
N = frame_size(Is, Safe),
- IsKilled = fun(R) -> beam_utils:is_killed(R, Is, D) end,
+ IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end,
{N,frame_layout_1(Kills, 0, N, IsKilled, [])}.
frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) ->
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index a15ecf633e..c91256f6bc 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -31,8 +31,7 @@
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
-record(live,
- {bl, %Block check fun.
- lbl, %Label to code index.
+ {lbl, %Label to code index.
res}). %Result cache for each label.
@@ -45,12 +44,16 @@
%% i.e. it is OK to enter the instruction sequence with Register
%% containing garbage.
-is_killed_block(R, Is) ->
- case check_killed_block(R, Is) of
- killed -> true;
- used -> false;
- transparent -> false
- end.
+is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
+ X >= Live;
+is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
+ not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is));
+is_killed_block(R, [{'%live',_,Regs}|Is]) ->
+ case R of
+ {x,X} when (Regs bsr X) band 1 =:= 0 -> true;
+ _ -> is_killed_block(R, Is)
+ end;
+is_killed_block(_, []) -> false.
%% is_killed(Register, [Instruction], State) -> true|false
%% Determine whether a register is killed by the instruction sequence.
@@ -63,20 +66,20 @@ is_killed_block(R, Is) ->
%% to determine the kill state across branches.
is_killed(R, Is, D) ->
- St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false
+ {_,_} -> false
end.
%% is_killed_at(Reg, Lbl, State) -> true|false
%% Determine whether Reg is killed at label Lbl.
is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
- St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St0 = #live{lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
- {used,_} -> false
+ {_,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -87,10 +90,10 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
%% across branches.
is_not_used(R, Is, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
- {killed,_} -> true;
- {used,_} -> false
+ {used,_} -> false;
+ {_,_} -> true
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -101,10 +104,10 @@ is_not_used(R, Is, D) ->
%% across branches.
is_not_used_at(R, Lbl, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St) of
- {killed,_} -> true;
- {used,_} -> false
+ {used,_} -> false;
+ {_,_} -> true
end.
%% index_labels(FunctionIs) -> State
@@ -245,15 +248,19 @@ join_even([S|Ss], [D|Ds]) -> [S,D|join_even(Ss, Ds)].
%% check_liveness(Reg, [Instruction], #live{}) ->
-%% {killed | used, #live{}}
+%% {killed | not_used | used, #live{}}
%% Find out whether Reg is used or killed in instruction sequence.
-%% 'killed' means that Reg is assigned a new value or killed by an
-%% allocation instruction. 'used' means that Reg is used in some way.
+%%
+%% killed - Reg is assigned or killed by an allocation instruction.
+%% not_used - the value of Reg is not used, but Reg must not be garbage
+%% used - Reg is used
-check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) ->
- case BlockCheck(R, Blk, St0) of
- {transparent,St} -> check_liveness(R, Is, St);
- {Other,_}=Res when is_atom(Other) -> Res
+check_liveness(R, [{block,Blk}|Is], St0) ->
+ case check_liveness_block(R, Blk, St0) of
+ {transparent,St1} ->
+ check_liveness(R, Is, St1);
+ {Other,_}=Res when is_atom(Other) ->
+ Res
end;
check_liveness(R, [{label,_}|Is], St) ->
check_liveness(R, Is, St);
@@ -263,8 +270,12 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) ->
{used,St0};
false ->
case check_liveness_at(R, Fail, St0) of
- {killed,St} -> check_liveness(R, Is, St);
- {_,_}=Other -> Other
+ {killed,St1} ->
+ check_liveness(R, Is, St1);
+ {not_used,St1} ->
+ not_used(check_liveness(R, Is, St1));
+ {used,_}=Used ->
+ Used
end
end;
check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) ->
@@ -334,7 +345,7 @@ check_liveness(R, [{call,Live,_}|Is], St) ->
case R of
{x,X} when X < Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
case R of
@@ -345,7 +356,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
{y,_} ->
case beam_jump:is_exit_instruction(I) of
false ->
- check_liveness(R, Is, St);
+ not_used(check_liveness(R, Is, St));
true ->
%% We must make sure we don't check beyond this
%% instruction or we will fall through into random
@@ -357,43 +368,20 @@ check_liveness(R, [{call_fun,Live}|Is], St) ->
case R of
{x,X} when X =< Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{apply,Args}|Is], St) ->
case R of
{x,X} when X < Args+2 -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
- end;
-check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St} = Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end;
-check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) ->
- case R of
- {x,X} when X >= Live ->
- {killed,St0};
- {x,_} ->
- {used,St0};
- _ ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St}=Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end
- end;
+ {y,_} -> not_used(check_liveness(R, Is, St))
+ end;
+check_liveness(R, [{bif,Op,Fail,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{bif,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
+check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{alloc,Live,{gc_bif,Op,Fail}}},
+ check_liveness(R, [{block,[Set]}|Is], St);
check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) ->
case member(R, Ss) of
true -> {used,St};
@@ -419,7 +407,7 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
case R of
{x,X} when X < NumFree -> {used,St};
{x,_} -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness({x,_}=R, [{'catch',_,_}|Is], St) ->
%% All x registers will be killed if an exception occurs.
@@ -488,18 +476,9 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) ->
Other
end
end;
-check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) ->
- case R of
- Src ->
- {used,St0};
- {x,X} when X < Live ->
- {used,St0};
- {x,_} ->
- {killed,St0};
- {y,_} ->
- %% Conservatively mark it as used.
- {used,St0}
- end;
+check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) ->
+ Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}},
+ check_liveness(R, [{block,[Set]}||Is], St);
check_liveness(R, [{test_heap,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
check_liveness(R, [I|Is], St);
@@ -512,16 +491,24 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
check_liveness(_R, Is, St) when is_list(Is) ->
%% Not implemented. Conservatively assume that the register is used.
{used,St}.
-
-check_liveness_everywhere(R, [{f,Lbl}|T], St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> check_liveness_everywhere(R, T, St);
- {_,_}=Other -> Other
+
+check_liveness_everywhere(R, Lbls, St0) ->
+ check_liveness_everywhere_1(R, Lbls, killed, St0).
+
+check_liveness_everywhere_1(R, [{f,Lbl}|T], Res0, St0) ->
+ {Res1,St} = check_liveness_at(R, Lbl, St0),
+ Res = case Res1 of
+ killed -> Res0;
+ _ -> Res1
+ end,
+ case Res of
+ used -> {used,St};
+ _ -> check_liveness_everywhere_1(R, T, Res, St)
end;
-check_liveness_everywhere(R, [_|T], St) ->
- check_liveness_everywhere(R, T, St);
-check_liveness_everywhere(_, [], St) ->
- {killed,St}.
+check_liveness_everywhere_1(R, [_|T], Res, St) ->
+ check_liveness_everywhere_1(R, T, Res, St);
+check_liveness_everywhere_1(_, [], Res, St) ->
+ {Res,St}.
check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
case gb_trees:lookup(Lbl, ResMemorized) of
@@ -535,56 +522,20 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
+not_used({killed,St}) -> {not_used,St};
+not_used({_,_}=Res) -> Res.
+
check_liveness_ret(R, R, St) -> {used,St};
check_liveness_ret(_, _, St) -> {killed,St}.
-check_liveness_fail(_, _, _, 0, St) ->
- {killed,St};
-check_liveness_fail(R, Op, Args, Fail, St) ->
- Arity = length(Args),
- case erl_internal:comp_op(Op, Arity) orelse
- erl_internal:new_type_test(Op, Arity) of
- true -> {killed,St};
- false -> check_liveness_at(R, Fail, St)
- end.
-
-%% check_killed_block(Reg, [Instruction], State) -> killed | transparent | used
-%% Finds out how Reg is used in the instruction sequence inside a block.
-%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
-%% transparent - Reg is neither used nor killed
-%% used - Reg is used or referenced by an allocation instruction.
-%%
-%% (Unknown instructions will cause an exception.)
-
-check_killed_block_fun() ->
- fun(R, Is, St) -> {check_killed_block(R, Is),St} end.
-
-check_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
- if
- X >= Live -> killed;
- true -> used
- end;
-check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
- case member(R, Ss) of
- true -> used;
- false ->
- case member(R, Ds) of
- true -> killed;
- false -> check_killed_block(R, Is)
- end
- end;
-check_killed_block(R, [{'%live',_,Regs}|Is]) ->
- case R of
- {x,X} when (Regs bsr X) band 1 =:= 0 -> killed;
- _ -> check_killed_block(R, Is)
- end;
-check_killed_block(_, []) -> transparent.
-
-%% check_used_block(Reg, [Instruction], State) -> killed | transparent | used
+%% check_liveness_block(Reg, [Instruction], State) ->
+%% {killed | not_used | used | transparent,State'}
%% Finds out how Reg is used in the instruction sequence inside a block.
%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
+%% killed - Reg is assigned a new value or killed by an
+%% allocation instruction
+%% not_used - The value is not used, but the register is referenced
+%% e.g. by an allocation instruction
%% transparent - Reg is neither used nor killed
%% used - Reg is explicitly used by an instruction
%%
@@ -592,45 +543,64 @@ check_killed_block(_, []) -> transparent.
%%
%% (Unknown instructions will cause an exception.)
-check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
+check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) ->
if
- X >= Live -> {killed,St};
- true -> check_used_block_1(R, Ss, Ds, Op, Is, St)
+ X >= Live ->
+ {killed,St0};
+ true ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {killed,St} -> {not_used,St};
+ {transparent,St} -> {not_used,St};
+ {_,_}=Res -> Res
+ end
end;
-check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
- check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(_, [], St) -> {transparent,St}.
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) ->
+ check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) ->
+ check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block(_, [], St) -> {transparent,St}.
-check_used_block_1(R, Ss, Ds, Op, Is, St0) ->
+check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
case member(R, Ss) of
true ->
{used,St0};
false ->
- case is_reg_used_at(R, Op, St0) of
- {true,St} ->
- {used,St};
- {false,St} ->
+ case check_liveness_block_2(R, Op, Ss, St0) of
+ {killed,St} ->
case member(R, Ds) of
true -> {killed,St};
- false -> check_used_block(R, Is, St)
- end
+ false -> check_liveness_block(R, Is, St)
+ end;
+ {not_used,St} ->
+ not_used(case member(R, Ds) of
+ true -> {killed,St};
+ false -> check_liveness_block(R, Is, St)
+ end);
+ {used,St} ->
+ {used,St}
end
end.
-is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(R, {bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(_, _, St) ->
- {false,St}.
+check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) ->
+ check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
+ Arity = length(Ss),
+ case erl_internal:comp_op(Op, Arity) orelse
+ erl_internal:new_type_test(Op, Arity) of
+ true ->
+ {killed,St};
+ false ->
+ check_liveness_block_3(R, Lbl, St)
+ end;
+check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) ->
+ check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(_, _, _, St) ->
+ {killed,St}.
-is_reg_used_at_1(_, 0, St) ->
- {false,St};
-is_reg_used_at_1(R, Lbl, St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> {false,St};
- {used,St} -> {true,St}
- end.
+check_liveness_block_3(_, 0, St) ->
+ {killed,St};
+check_liveness_block_3(R, Lbl, St0) ->
+ check_liveness_at(R, Lbl, St0).
index_labels_1([{label,Lbl}|Is0], Acc) ->
Is = drop_labels(Is0),
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index ffd136c6db..6e53f53a20 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -909,7 +909,7 @@ all_ms_in_x_regs(Live0, Vst) ->
ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) ->
Ys = gb_trees:to_list(Ys0),
- [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
+ [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) ->
case gb_trees:lookup(Lbl, Ft) of
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 67209d06be..cff6c7098b 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -179,7 +179,7 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt)
+format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt)
when is_map(M), map_size(M) =:= 0 ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 7693daaa56..831730ba48 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -207,7 +207,6 @@ is_safe(erlang, registered, 0) -> true;
is_safe(erlang, self, 0) -> true;
is_safe(erlang, term_to_binary, 1) -> true;
is_safe(erlang, time, 0) -> true;
-is_safe(error_logger, warning_map, 0) -> true;
is_safe(_, _, _) -> false.
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index caa30a5ef4..303ce52ee3 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -83,10 +83,11 @@
-ifdef(DEBUG).
-define(ASSERT(E),
case E of
- true -> ok;
+ true ->
+ ok;
false ->
io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]),
- exit(assertion_failed)
+ error(assertion_failed)
end).
-else.
-define(ASSERT(E), ignore).
@@ -120,7 +121,10 @@ module(#c_module{defs=Ds0}=Mod, Opts) ->
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
try
- B = expr(B0, value, sub_new()), %This must be a fun!
+ B = find_fixpoint(fun(Core) ->
+ %% This must be a fun!
+ expr(Core, value, sub_new())
+ end, B0, 20),
{Name,B}
catch
Class:Error ->
@@ -129,6 +133,14 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) ->
erlang:raise(Class, Error, Stack)
end.
+find_fixpoint(_OptFun, Core, 0) ->
+ Core;
+find_fixpoint(OptFun, Core0, Max) ->
+ case OptFun(Core0) of
+ Core0 -> Core0;
+ Core -> find_fixpoint(OptFun, Core, Max-1)
+ end.
+
%% body(Expr, Sub) -> Expr.
%% body(Expr, Context, Sub) -> Expr.
%% No special handling of anything except values.
@@ -239,7 +251,7 @@ expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Cons, useless_building),
- expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub);
+ make_effect_seq([H1,T1], Sub);
value ->
ann_c_cons(Anno, H1, T1)
end;
@@ -248,7 +260,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Tuple, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
ann_c_tuple(Anno, Es)
end;
@@ -257,7 +269,7 @@ expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Map, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
V = expr(V0, Ctxt, Sub),
ann_c_map(Anno,V,Es)
@@ -310,7 +322,7 @@ expr(#c_let{}=Let0, Ctxt, Sub) ->
Expr ->
%% The let body was successfully moved into the let argument.
%% Now recursively re-process the new expression.
- expr(Expr, Ctxt, sub_new_preserve_types(Sub))
+ Expr
end;
expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
%% This is named fun in an 'effect' context. Warn and ignore.
@@ -364,7 +376,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
impossible ->
bsm_an(Expr);
Other ->
- expr(Other, Ctxt, sub_new_preserve_types(Sub))
+ Other
end;
Other ->
expr(Other, Ctxt, Sub)
@@ -1397,9 +1409,6 @@ sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}.
sub_new(#sub{}=Sub) ->
Sub#sub{v=orddict:new(),t=#{}}.
-sub_new_preserve_types(#sub{}=Sub) ->
- Sub#sub{v=orddict:new()}.
-
sub_get_var(#c_var{name=V}=Var, #sub{v=S}) ->
case orddict:find(V, S) of
{ok,Val} -> Val;
@@ -2017,10 +2026,10 @@ case_opt_lit_1(_, []) -> [].
%% the clauses where it is actually needed.
case_opt_data(E, Cs0) ->
- Es = cerl:data_es(E),
TypeSig = {cerl:data_type(E),cerl:data_arity(E)},
- try case_opt_data_1(Cs0, Es, TypeSig) of
+ try case_opt_data_1(Cs0, TypeSig) of
Cs ->
+ Es = cerl:data_es(E),
{ok,Es,Cs}
catch
throw:impossible ->
@@ -2028,44 +2037,47 @@ case_opt_data(E, Cs0) ->
{error,Cs0}
end.
-case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], TypeSig) ->
P = case_opt_compiler_generated(P0),
- BindTo = #c_var{name=dummy},
- {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []),
- [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)];
-case_opt_data_1([], _, _) -> [].
+ {Ps1,Bs} = case_opt_data_2(P, TypeSig, Bs0),
+ [{Ps1++Ps0,C,PsAcc,Bs}|case_opt_data_1(Cs, TypeSig)];
+case_opt_data_1([], _) -> [].
-case_data_pat_alias(P, BindTo0, TypeSig, Bs0) ->
- case cerl:type(P) of
- alias ->
- %% Recursively handle the pattern and bind to
- %% the alias variable.
- BindTo = cerl:alias_var(P),
- Apat0 = cerl:alias_pat(P),
- Ann = [compiler_generated],
- Apat = cerl:set_ann(Apat0, Ann),
- {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0),
- {Ps,[{BindTo0,BindTo}|Bs]};
- var ->
- %% Here we will need to actually build the data and bind
- %% it to the variable.
+case_opt_data_2(P, TypeSig, Bs0) ->
+ case case_analyze_pat(P) of
+ {[],Pat} when Pat =/= none ->
+ DataEs = cerl:data_es(P),
+ {DataEs,Bs0};
+ {[V|Vs],none} ->
{Type,Arity} = TypeSig,
Ann = [compiler_generated],
Vars = make_vars(Ann, Arity),
Data = cerl:ann_make_data(Ann, Type, Vars),
- Bs = [{BindTo0,P},{P,Data}|Bs0],
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
{Vars,Bs};
- _ ->
- %% Since case_opt_nomatch/3 has removed all clauses that
- %% cannot match, we KNOW that this clause must match and
- %% that the pattern must be a data constructor.
- %% Here we must build the data and bind it to the variable.
+ {[V|Vs],Pat} when Pat =/= none ->
{Type,_} = TypeSig,
- DataEs = cerl:data_es(P),
+ DataEs = cerl:data_es(Pat),
Vars = pat_to_expr_list(DataEs),
Ann = [compiler_generated],
Data = cerl:ann_make_data(Ann, Type, Vars),
- {DataEs,[{BindTo0,Data}]}
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
+ {DataEs,Bs}
+ end.
+
+case_analyze_pat(P) ->
+ case_analyze_pat_1(P, [], none).
+
+case_analyze_pat_1(P, Vs, Pat) ->
+ case cerl:type(P) of
+ alias ->
+ V = cerl:alias_var(P),
+ Apat = cerl:alias_pat(P),
+ case_analyze_pat_1(Apat, [V|Vs], Pat);
+ var ->
+ {[P|Vs],Pat};
+ _ ->
+ {Vs,P}
end.
%% pat_to_expr(Pattern) -> Expression.
@@ -2216,24 +2228,24 @@ inverse_rel_op('=<') -> '>';
inverse_rel_op(_) -> no.
-%% opt_bool_case_in_let(LetExpr, Sub) -> Core
+%% opt_bool_case_in_let(LetExpr) -> Core
-opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
- opt_case_in_let_1(Vs, Arg, B, Let, Sub).
+opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
+ opt_bool_case_in_let_1(Vs, Arg, B, Let).
-opt_case_in_let_1([#c_var{name=V}], Arg,
- #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) ->
+opt_bool_case_in_let_1([#c_var{name=V}], Arg,
+ #c_case{arg=#c_var{name=V}}=Case0, Let) ->
case is_simple_case_arg(Arg) of
true ->
Case = opt_bool_case(Case0#c_case{arg=Arg}),
case core_lib:is_var_used(V, Case) of
- false -> expr(Case, sub_new(Sub));
+ false -> Case;
true -> Let
end;
false ->
Let
end;
-opt_case_in_let_1(_, _, _, Let, _) -> Let.
+opt_bool_case_in_let_1(_, _, _, Let) -> Let.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2641,25 +2653,23 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
false ->
%% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub))
+ #c_seq{arg=Arg,body=Body}
end;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
{Vs,Arg1,#c_literal{}} ->
Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- E = case Ctxt of
- effect ->
- %% Throw away the literal body.
- Arg;
- value ->
- %% Since the variable is not used in the body, we
- %% can rewrite the let to a sequence.
- %% let <Var> = Arg in Literal ==> seq Arg Literal
- #c_seq{arg=Arg,body=Body}
- end,
- expr(E, Ctxt, sub_new_preserve_types(Sub));
+ case Ctxt of
+ effect ->
+ %% Throw away the literal body.
+ Arg;
+ value ->
+ %% Since the variable is not used in the body, we
+ %% can rewrite the let to a sequence.
+ %% let <Var> = Arg in Literal ==> seq Arg Literal
+ #c_seq{arg=Arg,body=Body}
+ end;
{Vs,Arg1,Body} ->
%% If none of the variables are used in the body, we can
%% rewrite the let to a sequence:
@@ -2668,11 +2678,10 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
case is_any_var_used(Vs, Body) of
false ->
Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub));
+ #c_seq{arg=Arg,body=Body};
true ->
Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
- Let2 = opt_bool_case_in_let(Let1, Sub),
+ Let2 = opt_bool_case_in_let(Let1),
opt_case_in_let_arg(Let2, Ctxt, Sub)
end
end.
@@ -2830,16 +2839,16 @@ opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt,
opt_case_in_let_arg(Let, _, _) -> Let.
opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]},
- clauses=Cs}=Case0, Ctxt, Sub) ->
+ clauses=Cs}=Case0, _Ctxt, _Sub) ->
Let = mark_compiler_generated(Let0),
case Cs of
[#c_clause{body=#c_literal{}=BodyA}=Ca0,
#c_clause{body=#c_literal{}=BodyB}=Cb0] ->
Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}},
Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}},
- Case = Case0#c_case{clauses=[Ca,Cb]},
- expr(Case, Ctxt, sub_new_preserve_types(Sub));
- _ -> Let
+ Case0#c_case{clauses=[Ca,Cb]};
+ _ ->
+ Let
end;
opt_case_in_let_arg_1(Let, _, _, _) -> Let.
@@ -3442,12 +3451,18 @@ format_error(bin_var_used_in_guard) ->
verify_scope(E, #sub{s=Scope}) ->
Free0 = cerl_trees:free_variables(E),
Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names.
- case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of
- true -> true;
+ case is_subset_of_scope(Free, Scope) of
+ true ->
+ true;
false ->
io:format("~p\n", [E]),
io:format("~p\n", [Free]),
- io:format("~p\n", [cerl_sets:to_list(Scope)]),
+ io:format("~p\n", [ordsets:from_list(cerl_sets:to_list(Scope))]),
false
end.
+
+is_subset_of_scope([V|Vs], Scope) ->
+ cerl_sets:is_element(V, Scope) andalso is_subset_of_scope(Vs, Scope);
+is_subset_of_scope([], _) -> true.
+
-endif.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 4df1aadd0a..c2e0c2bd1a 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -151,6 +151,8 @@ cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
+cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) ->
+ internal_cg(Bif, As, Rs, Le, Vdb, Bef, St);
cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) ->
recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St);
cg(receive_next, Le, Vdb, Bef, St) ->
@@ -208,15 +210,10 @@ need_heap_1(#l{ke={set,_,Val}}, H) ->
{tuple,Es} -> 1 + length(Es);
_Other -> 0
end};
-need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,bs_init_writable,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) ->
{[],H};
need_heap_1(#l{i=I}, H) ->
+ %% Call or call-like instruction such as set_tuple_element/3.
{need_heap_need(I, H),0}.
need_heap_need(_I, 0) -> [];
@@ -1301,10 +1298,10 @@ trap_bif(erlang, group_leader, 2) -> true;
trap_bif(erlang, exit, 2) -> true;
trap_bif(_, _, _) -> false.
-%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
+internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
[Src] = cg_reg_args([Src0], Bef),
case is_register(Src) of
false ->
@@ -1312,25 +1309,34 @@ bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
true ->
{[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}
end;
-bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
+internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
[New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef),
Index = Index1-1,
{[{set_tuple_element,New,Tuple,Index}],
clear_dead(Bef, Le#l.i, Vdb), St0};
-bif_cg({make_fun,Func,Arity,Index,Uniq}, As, Rs, Le, Vdb, Bef, St0) ->
+internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) ->
%% This behaves more like a function call.
+ {atom,Func} = Func0,
+ {integer,Arity} = Arity0,
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{FuncLbl,St1} = local_func_label(Func, Arity, St0),
- MakeFun = {make_fun2,{f,FuncLbl},Index,Uniq,length(As)},
+ MakeFun = {make_fun2,{f,FuncLbl},0,0,length(As)},
{Sis ++ [MakeFun],
clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),
St1};
-bif_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
+internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
%% This behaves like a function call.
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
+internal_cg(raise, As, Rs, Le, Vdb, Bef, St) ->
+ %% raise can be treated like a guard BIF.
+ bif_cg(raise, As, Rs, Le, Vdb, Bef, St).
+
+%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% {[Ainstr],StackReg,State}.
+
bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index b4bbc5e739..859f110a53 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1734,15 +1734,15 @@ uexpr(#k_receive_accept{anno=A}, _, St) ->
{#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St};
uexpr(#k_receive_next{anno=A}, _, St) ->
{#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St};
-uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try,
+uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{break,Rs0}=Br, St0) ->
case is_in_guard(St0) of
true ->
{[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion.
#k_atom{val=false} = H0, %Assertion.
{A1,Bu,St1} = uexpr(A0, Br, St0),
- {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
- arg=A1,ret=Rs0},Bu,St1};
+ {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,ret=Rs0},Bu,St1};
false ->
{Avs,St1} = new_vars(length(Vs), St0),
{A1,Au,St2} = ubody(A0, {break,Avs}, St1),
@@ -1791,13 +1791,9 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
end,
Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity,
vars=Vs ++ Fvs,body=B1},
- %% Set dummy values for Index and Uniq -- the real values will
- %% be assigned by beam_asm.
- Index = Uniq = 0,
{#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A},
- op=#k_internal{name=make_fun,arity=length(Free)+3},
- args=[#k_atom{val=Fname},#k_int{val=Arity},
- #k_int{val=Index},#k_int{val=Uniq}|Fvs],
+ op=#k_internal{name=make_fun,arity=length(Free)+2},
+ args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs],
ret=Rs},
Free,add_local_function(Fun, St)};
uexpr(Lit, {break,Rs0}, St0) ->
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 5216a1a620..1169a69117 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -66,6 +66,7 @@
-record(k_receive_next, {anno=[]}).
-record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}).
-record(k_try_enter, {anno=[],arg,vars,body,evars,handler}).
+-record(k_protected, {anno=[],arg,ret=[]}).
-record(k_catch, {anno=[],body,ret=[]}).
-record(k_guard_match, {anno=[],vars,body,ret=[]}).
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 0b90f0a1e0..45065b7e11 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -279,6 +279,15 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
nl_indent(Ctxt),
"end"
];
+format_1(#k_protected{arg=A,ret=Rs}, Ctxt) ->
+ Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
+ ["protected",
+ nl_indent(Ctxt1),
+ format(A, Ctxt1),
+ nl_indent(Ctxt),
+ "end",
+ format_ret(Rs, ctxt_bump_indent(Ctxt, 1))
+ ];
format_1(#k_catch{body=B,ret=Rs}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
["catch",
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index 1452b78d1d..4337ec732c 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -78,9 +78,7 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
#k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
vars=Vs,body=Kb,ret=[]}
end,
- put(guard_refc, 0),
{B1,_,Vdb1} = body(B0, 1, Vdb0),
- erase(guard_refc),
{function,F,Ar,As,B1,Vdb1,Anno}
catch
Class:Error ->
@@ -106,12 +104,13 @@ body(Ke, I, Vdb0) ->
E = expr(Ke, I, Vdb1),
{[E],I,Vdb1}.
-%% guard(Kguard, I, Vdb) -> Guard.
+%% protected(Kprotected, I, Vdb) -> Protected.
+%% Only used in guards.
-guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false},ret=Rs}, I, Vdb) ->
+protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) ->
%% Lock variables that are alive before try and used afterwards.
- %% Don't lock variables that are only used inside the try expression.
+ %% Don't lock variables that are only used inside the protected
+ %% expression.
Pdb0 = vdb_sub(I, I+1, Vdb),
{T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
@@ -139,10 +138,9 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
M = match(Kb, A#k.us, I+1, [], Mdb),
#l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
expr(#k_try{}=Try, I, Vdb) ->
- case is_in_guard() of
- false -> body_try(Try, I, Vdb);
- true -> guard(Try, I, Vdb)
- end;
+ body_try(Try, I, Vdb);
+expr(#k_protected{}=Protected, I, Vdb) ->
+ protected(Protected, I, Vdb);
expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
%% Lock variables that are alive before the catch and used afterwards.
%% Don't lock variables that are only used inside the try.
@@ -213,7 +211,6 @@ body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs},
i=I,vdb=Tdb1,a=A#k.a}.
%% call_op(Op) -> Op.
-%% bif_op(Op) -> Op.
%% test_op(Op) -> Op.
%% Do any necessary name translations here to munge into beam format.
@@ -221,28 +218,14 @@ call_op(#k_local{name=N}) -> N;
call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)};
call_op(Other) -> variable(Other).
-bif_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N;
-bif_op(#k_internal{name=N}) -> N.
-
test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N.
%% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr.
-%% Build bifs, do special handling of internal some calls.
-
-k_bif(_A, #k_internal{name=dsetelement,arity=3}, As, []) ->
- {bif,dsetelement,atomic_list(As),[]};
-k_bif(_A, #k_internal{name=bs_context_to_binary=Op,arity=1}, As, []) ->
- {bif,Op,atomic_list(As),[]};
-k_bif(_A, #k_internal{name=bs_init_writable=Op,arity=1}, As, Rs) ->
- {bif,Op,atomic_list(As),var_list(Rs)};
-k_bif(_A, #k_internal{name=make_fun},
- [#k_atom{val=Fun},#k_int{val=Arity},
- #k_int{val=Index},#k_int{val=Uniq}|Free],
- Rs) ->
- {bif,{make_fun,Fun,Arity,Index,Uniq},var_list(Free),var_list(Rs)};
-k_bif(_A, Op, As, Rs) ->
- %% The general case.
- Name = bif_op(Op),
+%% Build bifs.
+
+k_bif(_A, #k_internal{name=Name}, As, Rs) ->
+ {internal,Name,atomic_list(As),var_list(Rs)};
+k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) ->
Ar = length(As),
case is_gc_bif(Name, Ar) of
false ->
@@ -303,9 +286,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
Gdb = vdb_sub(I+1, I+2, Vdb1),
- OldRefc = put(guard_refc, get(guard_refc)+1),
- G = guard(Kg, I+1, Gdb),
- put(guard_refc, OldRefc),
+ G = protected(Kg, I+1, Gdb),
B = match(Kb, Ls, I+2, Ctxt, Vdb1),
#l{ke={guard_clause,G,B},
i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
@@ -394,7 +375,6 @@ is_gc_bif(node, 0) -> false;
is_gc_bif(node, 1) -> false;
is_gc_bif(element, 2) -> false;
is_gc_bif(get, 1) -> false;
-is_gc_bif(raise, 2) -> false;
is_gc_bif(tuple_size, 1) -> false;
is_gc_bif(Bif, Arity) ->
not (erl_internal:bool_op(Bif, Arity) orelse
@@ -431,11 +411,6 @@ use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
add_var(V, F, L, Vdb) ->
vdb_store_new(V, {V,F,L}, Vdb).
-%% is_in_guard() -> true|false.
-
-is_in_guard() ->
- get(guard_refc) > 0.
-
%% vdb
vdb_new(Vs) ->
diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl
index f6d4a311bb..5e29f8d7b4 100644
--- a/lib/compiler/test/beam_utils_SUITE.erl
+++ b/lib/compiler/test/beam_utils_SUITE.erl
@@ -283,6 +283,9 @@ coverage(_Config) ->
{'EXIT',{function_clause,_}} = (catch town(overall, {{abc},alcohol})),
+ self() ! junk_message,
+ {"url",#{true:="url"}} = appointment(#{"resolution" => "url"}),
+
ok.
%% Cover check_liveness/3.
@@ -352,6 +355,9 @@ yellow(Hill) ->
Hill,
id(42).
+do(A, B) -> {A,B}.
+appointment(#{"resolution" := Url}) ->
+ do(receive _ -> Url end, #{true => Url}).
%% The identity function.
id(I) -> I.
diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl
index 6bde2f1da9..bba2058f2f 100644
--- a/lib/compiler/test/bif_SUITE.erl
+++ b/lib/compiler/test/bif_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
- beam_validator/1,trunc_and_friends/1]).
+ beam_validator/1,trunc_and_friends/1,cover_safe_bifs/1]).
suite() ->
[{ct_hooks,[ts_install_cth]}].
@@ -35,7 +35,8 @@ all() ->
groups() ->
[{p,[parallel],
[beam_validator,
- trunc_and_friends
+ trunc_and_friends,
+ cover_safe_bifs
]}].
init_per_suite(Config) ->
@@ -104,3 +105,18 @@ trunc_template(Func, Bif) ->
try begin _@Bif@(a), ok end
catch error:badarg -> ok end,
ok.").
+
+cover_safe_bifs(Config) ->
+ _ = get(),
+ _ = get_keys(a),
+ _ = group_leader(),
+ _ = is_alive(),
+ _ = min(Config, []),
+ _ = nodes(),
+ _ = erlang:ports(),
+ _ = pre_loaded(),
+ _ = processes(),
+ _ = registered(),
+ _ = term_to_binary(Config),
+
+ ok.
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 224abf6c29..f8af070c44 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -38,7 +38,8 @@
no_partition/1,calling_a_binary/1,binary_in_map/1,
match_string_opt/1,select_on_integer/1,
map_and_binary/1,unsafe_branch_caching/1,
- bad_literals/1,good_literals/1,constant_propagation/1]).
+ bad_literals/1,good_literals/1,constant_propagation/1,
+ parse_xml/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -69,7 +70,7 @@ groups() ->
no_partition,calling_a_binary,binary_in_map,
match_string_opt,select_on_integer,
map_and_binary,unsafe_branch_caching,
- bad_literals,good_literals,constant_propagation]}].
+ bad_literals,good_literals,constant_propagation,parse_xml]}].
init_per_suite(Config) ->
@@ -1451,6 +1452,26 @@ constant_propagation_c() ->
X
end.
+parse_xml(_Config) ->
+ <<"<?xmlX">> = do_parse_xml(<<"<?xmlX">>),
+ <<" ">> = do_parse_xml(<<"<?xml ">>),
+ ok.
+
+do_parse_xml(<<"<?xml"/utf8,Rest/binary>> = Bytes) ->
+ %% Delayed sub-binary creation is not safe. A buggy (development)
+ %% version of check_liveness_everywhere() in beam_utils would turn
+ %% on the optimization.
+ Rest1 = case is_next_char_whitespace(Rest) of
+ false ->
+ Bytes;
+ true ->
+ id(Rest)
+ end,
+ id(Rest1).
+
+is_next_char_whitespace(<<C/utf8,_/binary>>) ->
+ C =:= $\s.
+
check(F, R) ->
R = F().