Don't build a stacktrace if it's only passed to erlang:raise/3

Consider the following function:

    function({function,Name,Arity,CLabel,Is0}, Lc0) ->
      try
        %% Optimize the code for the function.
      catch
        Class:Error:Stack ->
          io:format("Function: ~w/~w\n", [Name,Arity]),
          erlang:raise(Class, Error, Stack)
      end.

The stacktrace is retrieved, but it is only used in the call
to erlang:raise/3. There is no need to build a stacktrace
in this function. We can avoid the building if we introduce
an instruction called raw_raise/3 that works exactly like
the erlang:raise/3 BIF except that its third argument must
be a raw stacktrace.

13 files changed, 312 insertions, 7 deletions

diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 22ba86fa38..50b76d7f29 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1088,6 +1088,8 @@ resolve_inst({get_map_elements,Args0},_,_,_) ->
 
 resolve_inst({build_stacktrace,[]},_,_,_) ->
     build_stacktrace;
+resolve_inst({raw_raise,[]},_,_,_) ->
+    raw_raise;
 
 %%
 %% Catches instructions that are not yet handled.
diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl
index 8cc0bcf99b..c3326c15a0 100644
--- a/lib/compiler/src/beam_disasm.hrl
+++ b/lib/compiler/src/beam_disasm.hrl
@@ -27,7 +27,7 @@
 %%      PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS.
 %%
 -type beam_instr() :: 'bs_init_writable' | 'build_stacktrace'
-                    | 'fclearerror' | 'if_end'
+                    | 'fclearerror' | 'if_end' | 'raw_raise'
                     | 'remove_message' | 'return' | 'send' | 'timeout'
                     | tuple().  %% XXX: Very underspecified - FIX THIS
 
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 901588ee3b..5333925589 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -871,6 +871,8 @@ live_opt([{block,Bl0}|Is], Regs0, D, Acc) ->
     live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]);
 live_opt([build_stacktrace=I|Is], _, D, Acc) ->
     live_opt(Is, live_call(1), D, [I|Acc]);
+live_opt([raw_raise=I|Is], _, D, Acc) ->
+    live_opt(Is, live_call(3), D, [I|Acc]);
 live_opt([{label,L}=I|Is], Regs, D0, Acc) ->
     D = gb_trees:insert(L, Regs, D0),
     live_opt(Is, Regs, D, [I|Acc]);
@@ -1142,6 +1144,8 @@ defs([{move,_,Dst}=I|Is], Regs0, D) ->
 defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) ->
     Regs = def_regs([Dst], Regs0),
     [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([raw_raise=I|Is], _Regs, D) ->
+    [I|defs(Is, 1, D)];
 defs([return=I|Is], _Regs, D) ->
     [I|defs_unreachable(Is, D)];
 defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) ->
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 4feb26c513..22ceef097c 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -524,6 +524,8 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
 valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) ->
     validate_src(Src, Vst),
     kill_state(Vst);
+valfun_4(raw_raise=I, Vst) ->
+    call(I, 3, Vst);
 valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
     validate_src(Src, Vst0),
     Vst = branch_state(Fail, Vst0),
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 397e478e1e..d59bb241a8 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -554,3 +554,13 @@ BEAM_FORMAT_NUMBER=0
 ##       Do a garbage collection if necessary to allocate space on the heap
 ##       for the result.
 160: build_stacktrace/0
+
+## @spec raw_raise
+## @doc  This instruction works like the erlang:raise/3 BIF, except that the
+##       stacktrace in x(2) must be a raw stacktrace.
+##       x(0) is the class of the exception (error, exit, or throw),
+##       x(1) is the exception term, and x(2) is the raw stackframe.
+##       If x(0) is not a valid class, the instruction will not throw an
+##       exception, but store the atom 'badarg' in x(0) and execute the
+##       next instruction.
+161: raw_raise/0
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 46816fe24a..a9bd363ee1 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2507,6 +2507,72 @@ are_all_failing_clauses(Cs) ->
 is_failing_clause(#c_clause{body=B}) ->
     will_fail(B).
 
+%% opt_build_stacktrace(Let) -> Core.
+%%  If the stacktrace is *only* used in a call to erlang:raise/3,
+%%  there is no need to build a cooked stackframe using build_stacktrace/1.
+
+opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}],
+                            arg=#c_primop{name=#c_literal{val=build_stacktrace},
+                                          args=[RawStk]},
+                            body=Body}=Let) ->
+    case Body of
+        #c_call{module=#c_literal{val=erlang},
+                name=#c_literal{val=raise},
+                args=[Class,Exp,#c_var{name=Cooked}]} ->
+            %% The stacktrace is only used in a call to erlang:raise/3.
+            %% There is no need to build the stacktrace. Replace the
+            %% call to erlang:raise/3 with the the raw_raise/3 instruction,
+            %% which will use a raw stacktrace.
+            #c_primop{name=#c_literal{val=raw_raise},
+                      args=[Class,Exp,RawStk]};
+        #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked ->
+            case core_lib:is_var_used(Cooked, Arg) of
+                false ->
+                    %% The built stacktrace is not used in the argument,
+                    %% so we can sink the building of the stacktrace into
+                    %% the body of the let.
+                    B = opt_build_stacktrace(Let#c_let{body=B0}),
+                    Body#c_let{body=B};
+                true ->
+                    Let
+            end;
+        #c_seq{arg=Arg,body=B0} ->
+            case core_lib:is_var_used(Cooked, Arg) of
+                false ->
+                    %% The built stacktrace is not used in the argument,
+                    %% so we can sink the building of the stacktrace into
+                    %% the body of the sequence.
+                    B = opt_build_stacktrace(Let#c_let{body=B0}),
+                    Body#c_seq{body=B};
+                true ->
+                    Let
+            end;
+        #c_case{arg=Arg,clauses=Cs0} ->
+            case core_lib:is_var_used(Cooked, Arg) orelse
+                is_used_in_any_guard(Cooked, Cs0) of
+                false ->
+                    %% The built stacktrace is not used in the argument,
+                    %% so we can sink the building of the stacktrace into
+                    %% each arm of the case.
+                    Cs = [begin
+                              B = opt_build_stacktrace(Let#c_let{body=B0}),
+                              C#c_clause{body=B}
+                          end || #c_clause{body=B0}=C <- Cs0],
+                    Body#c_case{clauses=Cs};
+                true ->
+                    Let
+            end;
+        _ ->
+            Let
+    end;
+opt_build_stacktrace(Expr) ->
+    Expr.
+
+is_used_in_any_guard(V, Cs) ->
+    any(fun(#c_clause{guard=G}) ->
+                core_lib:is_var_used(V, G)
+        end, Cs).
+
 %% opt_case_in_let(Let) -> Let'
 %%  Try to avoid building tuples that are immediately matched.
 %%  A common pattern is:
@@ -2712,8 +2778,9 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
 %%  Note that the substitutions and scope in Sub have been cleared
 %%  and should not be used.
 
-post_opt_let(Let, Sub) ->
-    opt_bool_case_in_let(Let, Sub).
+post_opt_let(Let0, Sub) ->
+    Let1 = opt_bool_case_in_let(Let0, Sub),
+    opt_build_stacktrace(Let1).
 
 
 %% remove_first_value(Core0, Sub) -> Core.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 8f3399d133..a96d58a903 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1855,7 +1855,12 @@ internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) ->
     {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb),
     Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}},
     Is = Ms++[line(Le),Call],
-    {Is,Bef,St}.
+    {Is,Bef,St};
+internal_cg(raw_raise=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}.
 
 %% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
 %%      {[Ainstr],StackReg,State}.
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 8cf7928cc4..d5a1dc642f 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -27,7 +27,7 @@
 	 nested_horrid/1,last_call_optimization/1,bool/1,
 	 plain_catch_coverage/1,andalso_orelse/1,get_in_try/1,
 	 hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1,
-         stacktrace/1,nested_stacktrace/1]).
+         stacktrace/1,nested_stacktrace/1,raise/1]).
 
 -include_lib("common_test/include/ct.hrl").
 
@@ -44,7 +44,7 @@ groups() ->
        nested_after,nested_horrid,last_call_optimization,
        bool,plain_catch_coverage,andalso_orelse,get_in_try,
        hockey,handle_info,catch_in_catch,grab_bag,
-       stacktrace,nested_stacktrace]}].
+       stacktrace,nested_stacktrace,raise]}].
 
 
 init_per_suite(Config) ->
@@ -117,6 +117,16 @@ basic(Conf) when is_list(Conf) ->
 	 catch nisse -> erro
 	 end,
 
+    %% Unmatchable clauses.
+    try
+        throw(thrown)
+    catch
+        {a,b}={a,b,c} ->                        %Intentionally no match.
+            ok;
+        thrown ->
+            ok
+    end,
+
     ok.
 
 after_call() ->
@@ -1159,5 +1169,99 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
             {caught1,S1,T2}
     end.
 
+raise(_Config) ->
+    test_raise(fun() -> exit({exit,tuple}) end),
+    test_raise(fun() -> abs(id(x)) end),
+    test_raise(fun() -> throw({was,thrown}) end),
+
+    badarg = bad_raise(fun() -> abs(id(x)) end),
+
+    ok.
+
+bad_raise(Expr) ->
+    try
+        Expr()
+    catch
+        _:E:Stk ->
+            erlang:raise(bad_class, E, Stk)
+    end.
+
+test_raise(Expr) ->
+    test_raise_1(Expr),
+    test_raise_2(Expr),
+    test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+    erase(exception),
+    try
+        do_test_raise_1(Expr)
+    catch
+        C:E:Stk ->
+            {C,E,Stk} = erase(exception)
+    end.
+
+do_test_raise_1(Expr) ->
+    try
+        Expr()
+    catch
+        C:E:Stk ->
+            %% Here the stacktrace must be built.
+            put(exception, {C,E,Stk}),
+            erlang:raise(C, E, Stk)
+    end.
+
+test_raise_2(Expr) ->
+    erase(exception),
+    try
+        do_test_raise_2(Expr)
+    catch
+        C:E:Stk ->
+            {C,E} = erase(exception),
+            try
+                Expr()
+            catch
+                _:_:S ->
+                    [StkTop|_] = S,
+                    [StkTop|_] = Stk
+            end
+    end.
+
+do_test_raise_2(Expr) ->
+    try
+        Expr()
+    catch
+        C:E:Stk ->
+            %% Here it is possible to replace erlang:raise/3 with
+            %% the raw_raise/3 instruction since the stacktrace is
+            %% not actually used.
+            put(exception, {C,E}),
+            erlang:raise(C, E, Stk)
+    end.
+
+test_raise_3(Expr) ->
+    try
+        do_test_raise_3(Expr)
+    catch
+        exit:{exception,C,E}:Stk ->
+            try
+                Expr()
+            catch
+                C:E:S ->
+                    [StkTop|_] = S,
+                    [StkTop|_] = Stk
+            end
+    end.
+
+do_test_raise_3(Expr) ->
+    try
+        Expr()
+    catch
+        C:E:Stk ->
+            %% Here it is possible to replace erlang:raise/3 with
+            %% the raw_raise/3 instruction since the stacktrace is
+            %% not actually used.
+            erlang:raise(exit, {exception,C,E}, Stk)
+    end.
+
 
 id(I) -> I.
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 7ff9fd83eb..6e66ec057c 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -1164,6 +1164,12 @@ trans_fun([build_stacktrace|Instructions], Env) ->
   Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
   [hipe_icode:mk_primop(Vars,build_stacktrace,Vars),
    trans_fun(Instructions, Env)];
+%%--- raw_raise ---
+trans_fun([raw_raise|Instructions], Env) ->
+  Vars = [mk_var({x,0}),mk_var({x,1}),mk_var({x,2})],
+  Dst = [mk_var({x,0})],
+  [hipe_icode:mk_primop(Dst,raw_raise,Vars) |
+   trans_fun(Instructions, Env)];
 %%--------------------------------------------------------------------
 %%--- ERROR HANDLING ---
 %%--------------------------------------------------------------------
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index 941516e8b1..a1f1128124 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -236,6 +236,7 @@ fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true;
 fails({hipe_bs_primop, bs_init_writable}) -> true;
 fails(build_stacktrace) -> false;
+fails(raw_raise) -> true;
 fails(#mkfun{}) -> false;
 fails(#unsafe_element{}) -> false;
 fails(#unsafe_update_element{}) -> false;
@@ -735,6 +736,8 @@ type(Primop, Args) ->
       erl_types:t_any();
     build_stacktrace ->
       erl_types:t_list();
+    raw_raise ->
+      erl_types:t_atom();
     {M, F, A} ->
       erl_bif_types:type(M, F, A, Args)
   end.
@@ -909,6 +912,8 @@ type(Primop) ->
 %%% Other
     build_stacktrace ->
       erl_types:t_any();
+    raw_raise ->
+      erl_types:t_any();
     #closure_element{} ->
       erl_types:t_any();
     redtest ->
diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl
index cf74c1eb5b..34b18acccd 100644
--- a/lib/hipe/icode/hipe_icode_range.erl
+++ b/lib/hipe/icode/hipe_icode_range.erl
@@ -1187,7 +1187,8 @@ basic_type(unsafe_tl) -> not_int;
 basic_type(#element{}) -> not_analysed;
 basic_type(#unsafe_element{}) -> not_analysed;
 basic_type(#unsafe_update_element{}) -> not_analysed;
-basic_type(build_stacktrace) -> not_int.
+basic_type(build_stacktrace) -> not_int;
+basic_type(raw_raise) -> not_int.
 
 -spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple().
 
diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl
index d646b78a3d..ce5433379e 100644
--- a/lib/hipe/rtl/hipe_rtl_primops.erl
+++ b/lib/hipe/rtl/hipe_rtl_primops.erl
@@ -396,6 +396,8 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
 	    [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
           build_stacktrace ->
 	    [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
+          raw_raise ->
+	    [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
 
 	  %% Only names listed above are accepted! MFA:s are not primops!
 	  _ ->
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index d71b924d22..ba9c03d4ba 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -24,6 +24,7 @@ test() ->
   ok = test_bad_fun_call(),
   ok = test_guard_bif(),
   ok = test_eclectic(),
+  ok = test_raise(),
   ok.
 
 %%--------------------------------------------------------------------
@@ -579,3 +580,99 @@ my_add(A, B) ->
 
 my_abs(X) ->
   abs(X).
+
+test_raise() ->
+  test_raise(fun() -> exit({exit,tuple}) end),
+  test_raise(fun() -> abs(id(x)) end),
+  test_raise(fun() -> throw({was,thrown}) end),
+
+  badarg = bad_raise(fun() -> abs(id(x)) end),
+
+  ok.
+
+bad_raise(Expr) ->
+  try
+    Expr()
+  catch
+    _:E:Stk ->
+      erlang:raise(bad_class, E, Stk)
+  end.
+
+test_raise(Expr) ->
+  test_raise_1(Expr),
+  test_raise_2(Expr),
+  test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+  erase(exception),
+  try
+    do_test_raise_1(Expr)
+  catch
+    C:E:Stk ->
+      {C,E,Stk} = erase(exception)
+  end.
+
+do_test_raise_1(Expr) ->
+  try
+    Expr()
+  catch
+    C:E:Stk ->
+      %% Here the stacktrace must be built.
+      put(exception, {C,E,Stk}),
+      erlang:raise(C, E, Stk)
+  end.
+
+test_raise_2(Expr) ->
+  erase(exception),
+  try
+    do_test_raise_2(Expr)
+  catch
+    C:E:Stk ->
+      {C,E} = erase(exception),
+      try
+        Expr()
+      catch
+        _:_:S ->
+          [StkTop|_] = S,
+          [StkTop|_] = Stk
+      end
+  end.
+
+do_test_raise_2(Expr) ->
+  try
+    Expr()
+  catch
+    C:E:Stk ->
+      %% Here it is possible to replace erlang:raise/3 with
+      %% the raw_raise/3 instruction since the stacktrace is
+      %% not actually used.
+      put(exception, {C,E}),
+      erlang:raise(C, E, Stk)
+  end.
+
+test_raise_3(Expr) ->
+  try
+    do_test_raise_3(Expr)
+  catch
+    exit:{exception,C,E}:Stk ->
+      try
+        Expr()
+      catch
+        C:E:S ->
+          [StkTop|_] = S,
+          [StkTop|_] = Stk
+      end
+  end.
+
+do_test_raise_3(Expr) ->
+  try
+    Expr()
+  catch
+    C:E:Stk ->
+      %% Here it is possible to replace erlang:raise/3 with
+      %% the raw_raise/3 instruction since the stacktrace is
+      %% not actually used.
+      erlang:raise(exit, {exception,C,E}, Stk)
+  end.
+
+id(I) -> I.