Merge branch 'bjorn/better-fun-info/OTP-15837'

* bjorn/better-fun-info/OTP-15837:
  Create a shared wrapper function for all occurrences of 'fun F/A'
  Support sharing of fun entries in the runtime system
  erl_fun.c: Remove unused struct definition
  hipe: Use the new index when translating funs
  Stop supporting decoding of old funs in the external term format
  genop.tab: Insert an "OTP 23" comment for clarity

7 files changed, 115 insertions, 38 deletions

diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index df09dcb06c..60e19ec596 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) ->
 assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) ->
     {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
     {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
+    Dict2 = shared_fun_wrappers(CompilerOpts, Dict1),
     NumFuncs = length(Asm0),
     {Asm,Attr} = on_load(Asm0, Attr0),
     Exp = cerl_sets:from_list(Exp0),
-    {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
-    build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts).
+    {Code,Dict} = assemble_1(Asm, Exp, Dict2, []),
+    build_file(Code, Attr, Dict, NumLabels, NumFuncs,
+               ExtraChunks, CompileInfo, CompilerOpts).
+
+shared_fun_wrappers(Opts, Dict) ->
+    case proplists:get_bool(no_shared_fun_wrappers, Opts) of
+        false ->
+            %% The compiler in OTP 23 depends on the on the loader
+            %% using the new indices in funs and being able to have
+            %% multiple make_fun2 instructions referring to the same
+            %% fun entry. Artificially set the highest opcode for the
+            %% module to ensure that it cannot be loaded in OTP 22
+            %% and earlier.
+            Swap = beam_opcodes:opcode(swap, 2),
+            beam_dict:opcode(Swap, Dict);
+        true ->
+            %% Fun wrappers are not shared for compatibility with a
+            %% previous OTP release.
+            Dict
+    end.
 
 on_load(Fs0, Attr0) ->
     case proplists:get_value(on_load, Attr0) of
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index b2056332e6..4d0cec857d 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -40,6 +40,7 @@
 
 -type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}.
 -type lambda_tab() :: {non_neg_integer(),[lambda_info()]}.
+-type wrapper() :: #{label() => index()}.
 
 -record(asm,
 	{atoms = #{}                :: atom_tab(),
@@ -48,6 +49,7 @@
 	 imports = gb_trees:empty() :: import_tab(),
 	 strings = <<>>		    :: binary(),	%String pool
 	 lambdas = {0,[]}           :: lambda_tab(),
+         wrappers = #{}             :: wrapper(),
 	 literals = dict:new()	    :: literal_tab(),
 	 fnames = #{}               :: fname_tab(),
 	 lines = #{}                :: line_tab(),
@@ -147,11 +149,21 @@ string(BinString, Dict) when is_binary(BinString) ->
 -spec lambda(label(), non_neg_integer(), bdict()) ->
         {non_neg_integer(), bdict()}.
 
-lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
-    %% Set Index the same as OldIndex.
-    Index = OldIndex,
-    Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
-    {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
+lambda(Lbl, NumFree, #asm{wrappers=Wrappers0,
+                          lambdas={OldIndex,Lambdas0}}=Dict) ->
+    case Wrappers0 of
+        #{Lbl:=Index} ->
+            %% OTP 23: There old is a fun entry for this wrapper function.
+            %% Share the fun entry.
+            {Index,Dict};
+        #{} ->
+            %% Set Index the same as OldIndex.
+            Index = OldIndex,
+            Wrappers = Wrappers0#{Lbl=>Index},
+            Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
+            {OldIndex,Dict#asm{wrappers=Wrappers,
+                               lambdas={OldIndex+1,Lambdas}}}
+    end.
 
 %% Returns the index for a literal (adding it to the literal table if necessary).
 %%    literal(Literal, Dict) -> {Index,Dict'}
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 098f82fdc0..42f9e8b902 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -265,9 +265,10 @@ expand_opt(r19, Os) ->
 expand_opt(r20, Os) ->
     expand_opt_before_21(Os);
 expand_opt(r21, Os) ->
-    [no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
+    [no_shared_fun_wrappers,
+     no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
 expand_opt(r22, Os) ->
-    [no_swap | Os];
+    [no_shared_fun_wrappers, no_swap | Os];
 expand_opt({debug_info_key,_}=O, Os) ->
     [encrypt_debug_info,O|Os];
 expand_opt(no_type_opt, Os) ->
@@ -277,7 +278,8 @@ expand_opt(no_type_opt, Os) ->
 expand_opt(O, Os) -> [O|Os].
 
 expand_opt_before_21(Os) ->
-    [no_swap, no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
+    [no_shared_fun_wrappers, no_swap,
+     no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
      no_utf8_atoms | expand_opt(no_bsm3, Os)].
 
 %% format_error(ErrorDescriptor) -> string()
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 03507bafb3..0a38d17857 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -597,6 +597,8 @@ BEAM_FORMAT_NUMBER=0
 ## @doc  Sets the current position of Ctx to Pos
 168: bs_set_position/2
 
+# OTP 23
+
 ## @spec swap Register1 Register2
 ## @doc  Swaps the contents of two registers.
 169: swap/2
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index e2b8787224..6fd1790c1a 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -81,8 +81,11 @@
 
 -export([module/2,format_error/1]).
 
--import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
-		keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]).
+-import(lists, [droplast/1,flatten/1,foldl/3,foldr/3,
+                map/2,mapfoldl/3,member/2,
+		keyfind/3,keyreplace/4,
+                last/1,partition/2,reverse/1,
+                splitwith/2,sort/1]).
 -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
 -import(cerl, [c_tuple/1]).
 
@@ -120,15 +123,19 @@ copy_anno(Kdst, Ksrc) ->
 	       funs=[],				%Fun functions
 	       free=#{},			%Free variables
 	       ws=[]   :: [warning()],		%Warnings.
-	       guard_refc=0}).			%> 0 means in guard
+	       guard_refc=0, 			%> 0 means in guard
+               no_shared_fun_wrappers=false :: boolean()
+              }).
 
 -spec module(cerl:c_module(), [compile:option()]) ->
 	{'ok', #k_mdef{}, [warning()]}.
 
-module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
+module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
     Kas = attributes(As),
     Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
-    St0 = #kern{},
+    NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers,
+                                             Options),
+    St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers},
     {Kfs,St} = mapfoldl(fun function/2, St0, Fs),
     {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
 		body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
@@ -716,16 +723,27 @@ gexpr_test_add(Ke, St0) ->
 %% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}.
 %%  Convert a Core expression, flattening it at the same time.
 
-expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) ->
-    %% A local in an expression.
-    %% For now, these are wrapped into a fun by reverse
-    %% eta-conversion, but really, there should be exactly one
-    %% such "lambda function" for each escaping local name,
-    %% instead of one for each occurrence as done now.
+expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) ->
     Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} ||
-	     V <- integers(1, Arity)],
-    Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
-    expr(Fun, Sub, St);
+             V <- integers(1, Arity)],
+    case St#kern.no_shared_fun_wrappers of
+        false ->
+            %% Generate a (possibly shared) wrapper function for calling
+            %% this function.
+            Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"],
+            Wrapper = list_to_atom(flatten(Wrapper0)),
+            Id = {id,{0,0,Wrapper}},
+            A = keyreplace(id, 1, A0, Id),
+            Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
+            expr(Fun, Sub, St);
+        true ->
+            %% For backward compatibility with OTP 22 and earlier,
+            %% use the pre-generated name for the fun wrapper.
+            %% There will be one wrapper function for each occurrence
+            %% of `fun F/A`.
+            Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}},
+            expr(Fun, Sub, St)
+    end;
 expr(#c_var{anno=A,name=V}, Sub, St) ->
     {#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
 expr(#c_literal{anno=A,val=V}, _Sub, St) ->
@@ -2446,8 +2464,21 @@ uexpr(Lit, {break,Rs0}, St0) ->
     {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
 	    arg=Lit,ret=Rs},Used,St1}.
 
-add_local_function(_, #kern{funs=ignore}=St) -> St;
-add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
+add_local_function(_, #kern{funs=ignore}=St) ->
+    St;
+add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) ->
+    case is_defined(Name, Arity, Funs) of
+        false ->
+            St#kern{funs=[F|Funs]};
+        true ->
+            St
+    end.
+
+is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) ->
+    true;
+is_defined(Name, Arity, [#k_fdef{}|T]) ->
+    is_defined(Name, Arity, T);
+is_defined(_, _, []) -> false.
 
 %% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
 make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 7e9e641478..453debc0c1 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1382,27 +1382,33 @@ env_compiler_options(_Config) ->
 bc_options(Config) ->
     DataDir = proplists:get_value(data_dir, Config),
 
-    L = [{101, small_float, [no_get_hd_tl,no_line_info]},
-         {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+    L = [{101, small_float, [no_shared_fun_wrappers,
+                             no_get_hd_tl,no_line_info]},
+         {103, big, [no_shared_fun_wrappers,
+                     no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
                      no_line_info,no_stack_trimming]},
-         {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]},
+         {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl,
+                             no_line_info,
+                             no_ssa_opt_float]},
 
-         {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+         {132, small, [no_shared_fun_wrappers,
+                       no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
                        no_ssa_opt_float,no_line_info,no_bsm3]},
 
+         {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl,
+                     no_ssa_opt_record,no_line_info]},
+
          {153, small, [r20]},
          {153, small, [r21]},
 
-         {136, big, [no_put_tuple2,no_get_hd_tl,
-                     no_ssa_opt_record,no_line_info]},
-
-         {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]},
+         {153, big, [no_shared_fun_wrappers,
+                     no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]},
          {153, big, [r16]},
          {153, big, [r17]},
          {153, big, [r18]},
          {153, big, [r19]},
          {153, small_float, [r16]},
-         {153, small_float, []},
+         {153, small_float, [no_shared_fun_wrappers]},
 
          {158, small_maps, [r17]},
          {158, small_maps, [r18]},
@@ -1412,11 +1418,15 @@ bc_options(Config) ->
 
          {164, small_maps, [r22]},
          {164, big, [r22]},
-         {164, small_maps, []},
-         {164, big, []},
+         {164, small_maps, [no_shared_fun_wrappers]},
+         {164, big, [no_shared_fun_wrappers]},
 
          {168, small, [r22]},
-         {168, small, []}
+         {168, small, [no_shared_fun_wrappers]},
+
+         {169, small_maps, []},
+         {169, big, []},
+         {169, small, []}
         ],
 
     Test = fun({Expected,Mod,Options}) ->
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 98210a351c..a468482acb 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -79,6 +79,7 @@ opt_opts(Mod) ->
                      (no_put_tuple2) -> true;
                      (no_recv_opt) -> true;
                      (no_share_opt) -> true;
+                     (no_shared_fun_wrappers) -> true;
                      (no_ssa_float) -> true;
                      (no_ssa_opt) -> true;
                      (no_stack_trimming) -> true;