Merge pull request #1713 from bjorng/bjorn/compiler/fix-unsafe-allocate

Fix unsafe use of 'allocate' where 'allocate_zero' should be used

2 files changed, 26 insertions, 8 deletions

diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 9543aa1355..7183381334 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -206,7 +206,7 @@ move_allocates([]) -> [].
 
 move_allocates_1([{'%anno',_}|Is], Acc) ->
     move_allocates_1(Is, Acc);
-move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) ->
+move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info0}}|Acc]=Acc0) ->
     case alloc_may_pass(I) of
         false ->
             move_allocates_1(Is, [I|Acc0]);
@@ -215,6 +215,7 @@ move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) ->
                 not_possible ->
                     move_allocates_1(Is, [I|Acc0]);
                 Live when is_integer(Live) ->
+                    Info = safe_info(Info0),
                     A = {set,[],[],{alloc,Live,Info}},
                     move_allocates_1(Is, [A,I|Acc])
             end
@@ -230,6 +231,13 @@ alloc_may_pass({set,_,_,put_list}) -> false;
 alloc_may_pass({set,_,_,put}) -> false;
 alloc_may_pass({set,_,_,_}) -> true.
 
+safe_info({nozero,Stack,Heap,_}) ->
+    %% nozero is not safe if the allocation instruction is moved
+    %% upwards past an instruction that may throw an exception
+    %% (such as element/2).
+    {zero,Stack,Heap,[]};
+safe_info(Info) -> Info.
+
 %% opt([Instruction]) -> [Instruction]
 %%  Optimize the instruction stream inside a basic block.
 
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 4dcce30583..a57dbbbc2f 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -440,8 +440,11 @@ check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) ->
 	    case member(R, Ss) of
 		true -> {used,St};
 		false ->
+                    %% If the exception is taken, the stack may
+                    %% be scanned. Therefore the register is not
+                    %% guaranteed to be killed.
 		    if
-			R =:= Dst -> {killed,St};
+                        R =:= Dst -> {not_used,St};
 			true -> not_used(check_liveness(R, Is, St))
 		    end
 	    end
@@ -735,8 +738,8 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
 	    end
     end.
 
-check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) ->
-    check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(R, {gc_bif,Op,{f,Lbl}}, Ss, St) ->
+    check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St);
 check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
     Arity = length(Ss),
     case erl_internal:comp_op(Op, Arity) orelse
@@ -744,16 +747,23 @@ check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
 	true ->
 	    {killed,St};
 	false ->
-	    check_liveness_block_3(R, Lbl, St)
+	    check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St)
     end;
 check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) ->
-    check_liveness_block_3(R, Lbl, St);
+    check_liveness_block_3(R, Lbl, {unsafe,0}, St);
 check_liveness_block_2(_, _, _, St) ->
     {killed,St}.
 
-check_liveness_block_3(_, 0, St) ->
+check_liveness_block_3({x,_}, 0, _FA, St) ->
     {killed,St};
-check_liveness_block_3(R, Lbl, St0) ->
+check_liveness_block_3({y,_}, 0, {F,A}, St) ->
+    %% If the exception is thrown, the stack may be scanned,
+    %% thus implicitly using the y register.
+    case erl_bifs:is_safe(erlang, F, A) of
+        true -> {killed,St};
+        false -> {used,St}
+    end;
+check_liveness_block_3(R, Lbl, _FA, St0) ->
     check_liveness_at(R, Lbl, St0).
 
 index_labels_1([{label,Lbl}|Is0], Acc) ->