From 86f82183855d6b21912e0e125b096a28a52bbcf6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 28 Jan 2019 15:10:34 +0100
Subject: Enhance optimization of function_clause exceptions

There is an optimization for reducing the number of instructions needed
to generate a `function_clause`. After the latest improvements of the
type optimization pass, that optimization is not always applied.

Here is an example:

    -export([foo/3]).

    foo(X, Y, Z) ->
        bar(a, X, Y, Z).

    bar(a, X, Y, Z) when is_tuple(X) ->
        {X,Y,Z}.

Note that the compiler internally adds a clause to each function to
generate a `function_clause` exception. Thus:

    bar(a, X, Y, Z) when is_tuple(X) ->
        {X,Y,Z};
    bar(A1, A2, A3, A4) ->
        erlang:error(function_clause, [A1,A2,A3,A4]).

Optimizations will rewrite the code basically like this:

    bar(_, X, Y, Z) when is_tuple(X) ->
        {X,Y,Z};
    bar(_, A2, A3, A4) ->
        erlang:error(function_clause, [a,A2,A3,A4]).

Note the `a` as the first element of the list of arguments. It
will prevent the optimization of the `function_clause` exception.

The BEAM code for `bar/4` looks like this:

    {function, bar, 4, 4}.
      {label,3}.
        {line,[{location,"t.erl",8}]}.
        {func_info,{atom,t},{atom,bar},4}.
      {label,4}.
        {'%',{type_info,{x,0},{atom,a}}}.
        {test,is_tuple,{f,5},[{x,1}]}.
        {test_heap,4,4}.
        {put_tuple2,{x,0},{list,[{x,1},{x,2},{x,3}]}}.
        return.
      {label,5}.
        {test_heap,8,4}.
        {put_list,{x,3},nil,{x,0}}.
        {put_list,{x,2},{x,0},{x,0}}.
        {put_list,{x,1},{x,0},{x,0}}.
        {put_list,{atom,a},{x,0},{x,1}}.
        {move,{atom,function_clause},{x,0}}.
        {line,[{location,"t.erl",8}]}.
        {call_ext,2,{extfunc,erlang,error,2}}.

The code after label 5 is the clause that generates the
`function_clause` exception.

This commit generalizes the optimization so that it can be applied for
this function:

    {function, bar, 4, 4}.
      {label,3}.
        {line,[{location,"t.erl",8}]}.
        {func_info,{atom,t},{atom,bar},4}.
      {label,4}.
        {'%',{type_info,{x,0},{atom,a}}}.
        {test,is_tuple,{f,5},[{x,1}]}.
        {test_heap,4,4}.
        {put_tuple2,{x,0},{list,[{x,1},{x,2},{x,3}]}}.
        return.
      {label,5}.
        {move,{atom,a},{x,0}}.
        {jump,{f,3}}.

For this particular function, it would be safe to omit the
`move` instruction before the `{jump,{f,3}}` instruction, but
it would not be safe in general to omit `move` instructions.
---
 lib/compiler/src/beam_except.erl | 51 +++++++++++++++++++++++++---------------
 1 file changed, 32 insertions(+), 19 deletions(-)

(limited to 'lib/compiler/src/beam_except.erl')

diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index 26b193a35b..254a716b81 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -31,7 +31,7 @@
 %%% erlang:error(function_clause, Args)  => jump FuncInfoLabel
 %%%
 
--import(lists, [reverse/1,seq/2,splitwith/2]).
+-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]).
 
 -spec module(beam_utils:module_code(), [compile:option()]) ->
                     {'ok',beam_utils:module_code()}.
@@ -53,7 +53,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
 -record(st,
 	{lbl :: beam_asm:label(),              %func_info label
 	 loc :: [_],                           %location for func_info
-	 arity :: arity()                       %arity for function
+	 arity :: arity()                      %arity for function
 	 }).
 
 function_1(Is0) ->
@@ -150,10 +150,15 @@ dig_out_fc(Arity, Is0) ->
                              (_) -> true
                           end, Is0),
     {Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0),
-    case is_fc(Arity, Regs) of
-        true ->
-            {yes,function_clause,Acc};
-        false ->
+    case Regs of
+        #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
+            case moves_from_stack(Args, 0, []) of
+                {Moves,Arity} ->
+                    {yes,function_clause,reverse(Moves, Acc)};
+                {_,_} ->
+                    no
+            end;
+        #{} ->
             no
     end.
 
@@ -187,22 +192,30 @@ dig_out_fc_block([], Regs) -> Regs.
 prune_xregs(Live, Regs) ->
     maps:filter(fun({x,X}, _) -> X < Live end, Regs).
 
-is_fc(Arity, Regs) ->
-    case Regs of
-        #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
-            is_fc_1(Args, 0) =:= Arity;
-        #{} ->
-            false
-    end.
-
-is_fc_1({cons,{arg,I},T}, I) ->
-    is_fc_1(T, I+1);
-is_fc_1(nil, I) ->
-    I;
-is_fc_1(_, _) -> -1.
+moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I ->
+    %% Wrong argument. Give up.
+    {[],-1};
+moves_from_stack({cons,H,T}, I, Acc) ->
+    case H of
+        {arg,I} ->
+            moves_from_stack(T, I+1, Acc);
+        _ ->
+            moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc])
+    end;
+moves_from_stack(nil, I, Acc) ->
+    {reverse(Acc),I};
+moves_from_stack({literal,[H|T]}, I, Acc) ->
+    Cons = {cons,tag_literal(H),tag_literal(T)},
+    moves_from_stack(Cons, I, Acc).
 
 get_reg(R, Regs) ->
     case Regs of
         #{R:=Val} -> Val;
         #{} -> R
     end.
+
+tag_literal([]) -> nil;
+tag_literal(T) when is_atom(T) -> {atom,T};
+tag_literal(T) when is_float(T) -> {float,T};
+tag_literal(T) when is_integer(T) -> {integer,T};
+tag_literal(T) -> {literal,T}.
-- 
cgit v1.2.3