Fix unsafe optimization of funs

Commits 53bd4974a101 and 726f6e4c7afe simplified the handling of
match_fail (used to generated exceptions such as 'function_clause')
by first rewriting them to a call to erlang/error{1,2} and later
rewriting them to specialized BEAM instructions (to reduce the
code size).

There was one flaw, though, which only was exposed when more
aggressive optimizations were added in c3b60f86c622. Here is an
example to explain it:

t(V) ->
    fun(get) -> V end.

The following BEAM code will be initially generated for the fun:

{function, '-t/1-fun-0-', 2, 5}.
  {label,1}.
    {line,[{location,"t.erl",5}]}.
    {func_info,{atom,t},{atom,'-t/1-fun-0-'},2}.
  {label,2}.
    {test,is_eq_exact,{f,2},[{x,0},{atom,get}]}.
    {move,{x,1},{x,0}}.
    return.
  {label,2}.
    {test_heap,2,1}.
    {put_list,{x,0},nil,{x,1}}.
    {move,{atom,function_clause},{x,0}}.
    {line,[{location,"t.erl",5}]}.
    {call_ext_only,2,{extfunc,erlang,error,2}}.

Translating back to Erlang code, that would be roughly:

'-t/1-fun-0-'(get, V) -> V;
'-t/1-fun-0-'(Arg1, _) -> erlang:error(function_clause, [Arg1]).

Note that the second argument (the free variable V) is not included
in the call to erlang:error/2.

The beam_except pass will simplify the code to:

{function, '-t/1-fun-0-', 2, 8}.
  {label,1}.
    {line,[{location,"t.erl",5}]}.
    {func_info,{atom,t},{atom,'-t/1-fun-0-'},2}.
  {label,2}.
    {test,is_eq_exact,{f,1},[{x,0},{atom,get}]}.
    {move,{x,1},{x,0}}.
    return.

The code has been shortened by jumping to the func_info/3 instruction.
Translating back to Erlang:

'-t/1-fun-0-'(get, V) -> V;
'-t/1-fun-0-'(Arg1, Arg2) -> erlang:error(function_clause, [Arg1,Arg2]).

it is clear that both arguments are now included in the
'function_clause' exception, even though the initially generated
code only included the first argument.

That is no problem in this particular case, but for some more complex
funs, optimizing the first version based on variable usage could make
the second version unsafe.

I rejected the following potential solutions:

- Including the free arguments in the call to erlang:error/2:

'-t/1-fun-0-'(get, V) -> V;
'-t/1-fun-0-'(Arg1, Arg2) -> erlang:error(function_clause, [Arg1,Arg2]).

Unfortunately, that is tricky. The free variables are only known
after the second pass in v3_kernel when variable usage has been
calculated. We would need to add a third pass (only for funs) that
would the free arguments to the second argument for erlang:error/2
*and* update the variable usage information.

- Calling beam_except earlier, from within beam_block before any
  optimizations based on variable usages are done.  But means that the
  problem could reappear in some other form in the future when other
  updates are done to the code generator and/or optimization passes.

The solution I have chosen is to modify beam_except to only replace
a call to erlang:error(function_class, Args) if the length of Args
is the same as the arity in the func_info/3 instruction. The code
will be slightly larger. Also, the free variables for funs and list
comprehensions will no longer be included in the function_clause
exception (that could be less confusing, but it also means less
information during debugging).

2 files changed, 33 insertions, 9 deletions

diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index eddb41a358..e5ec1bd904 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -49,13 +49,14 @@ function({function,Name,Arity,CLabel,Is0}) ->
 
 -record(st,
 	{lbl,					%func_info label
-	 loc					%location for func_info
+	 loc,					%location for func_info
+	 arity					%arity for function
 	 }).
 
 function_1(Is0) ->
     case Is0 of
-	[{label,Lbl},{line,Loc}|_] ->
-	    St = #st{lbl=Lbl,loc=Loc},
+	[{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] ->
+	    St = #st{lbl=Lbl,loc=Loc,arity=Arity},
 	    translate(Is0, St, []);
 	[{label,_}|_] ->
 	    %% No line numbers. The source must be a .S file.
@@ -74,14 +75,14 @@ translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) ->
     case dig_out(Ar, Acc1) of
 	no ->
 	    translate(Is, St, [I|Acc0]);
-	{yes,function_clause,Acc2} ->
+	{yes,{function_clause,Arity},Acc2} ->
 	    case {Line,St} of
-		{{line,Loc},#st{lbl=Fi,loc=Loc}} ->
+		{{line,Loc},#st{lbl=Fi,loc=Loc,arity=Arity}} ->
 		    Instr = {jump,{f,Fi}},
 		    translate(Is, St, [Instr|Acc2]);
 		{_,_} ->
 		    %% This must be "error(function_clause, Args)" in
-		    %% the Erlang source code. Don't translate.
+		    %% the Erlang source code or a fun. Don't translate.
 		    translate(Is, St, [I|Acc0])
 	    end;
 	{yes,Instr,Acc2} ->
@@ -135,11 +136,16 @@ fix_block(Is0, Words) ->
     [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is].
 
 dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) ->
-    dig_out_fc(Bl, Live-1, nil);
+    case dig_out_fc(Bl, Live-1, nil) of
+	no ->
+	    no;
+	yes ->
+	    {yes,{function_clause,Live}}
+    end;
 dig_out_block_fc(_) -> no.
 
 dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) ->
     dig_out_fc(Is, Reg-1, Dst);
 dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) ->
-    {yes,function_clause};
+    yes;
 dig_out_fc(_, _, _) -> no.
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index f8f74e6f7a..a62ec7ce79 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -50,7 +50,8 @@ groups() ->
        trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481,
        otp_5553,otp_5632,otp_5714,otp_5872,otp_6121,
        otp_6121a,otp_6121b,otp_7202,otp_7345,on_load,
-       string_table,otp_8949_a,otp_8949_a,split_cases]}].
+       string_table,otp_8949_a,otp_8949_a,split_cases,
+       beam_utils_liveopt]}].
 
 init_per_suite(Config) ->
     Config.
@@ -683,4 +684,21 @@ do_split_cases(A) ->
     end,
     Z.
 
+-record(alarmInfo, {type,cause,origin}).
+
+beam_utils_liveopt(Config) ->
+    F = beam_utils_liveopt_fun(42, pebkac, user),
+    void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}),
+    ok.
+    
+beam_utils_liveopt_fun(Peer, Cause, Origin) ->
+    fun(PeerNo, AlarmInfo)
+	  when PeerNo == Peer andalso
+	       AlarmInfo == #alarmInfo{type=sctp,
+				       cause=Cause,
+				       origin=Origin} ->
+	    void
+    end.
+
+
 id(I) -> I.