Merge pull request #1812 from michalmuskala/mm/make-fun-loader

Optimise creation of anonymous functions

9 files changed, 91 insertions, 27 deletions

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 8e014c3010..bd33e35603 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -1751,6 +1751,10 @@ true</pre>
           <item>
             <p><c>Pid</c> is the process identifier of the process
               that originally created the fun.</p>
+            <p>It might point to the <c>init</c> process if the
+              <c>Fun</c> was statically allocated when module was
+              loaded (this optimisation is performed for local
+              functions that do not capture the enviornment).</p>
           </item>
           <tag><c>{index, Index}</c></tag>
           <item>
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index e61199a8fd..50cbb37f3e 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4245,21 +4245,55 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
 {
     ErlFunEntry* fe;
     GenOp* op;
+    Uint arity, num_free;
 
     if (idx.val >= stp->num_lambdas) {
-	stp->lambda_error = "missing or short chunk 'FunT'";
-	fe = 0;
+        stp->lambda_error = "missing or short chunk 'FunT'";
+        fe = 0;
+        num_free = 0;
+        arity = 0;
     } else {
-	fe = stp->lambdas[idx.val].fe;
+        fe = stp->lambdas[idx.val].fe;
+        num_free = stp->lambdas[idx.val].num_free;
+        arity = fe->arity;
     }
 
     NEW_GENOP(stp, op);
-    op->op = genop_i_make_fun_2;
-    op->arity = 2;
-    op->a[0].type = TAG_u;
-    op->a[0].val = (BeamInstr) fe;
-    op->a[1].type = TAG_u;
-    op->a[1].val = stp->lambdas[idx.val].num_free;
+
+    /*
+     * It's possible this is called before init process is started,
+     * skip the optimisation in such case.
+     */
+    if (num_free == 0 && erts_init_process_id != ERTS_INVALID_PID) {
+        Uint lit;
+        Eterm* hp;
+        ErlFunThing* funp;
+
+        lit = new_literal(stp, &hp, ERL_FUN_SIZE);
+        funp = (ErlFunThing *) hp;
+        erts_refc_inc(&fe->refc, 2);
+        funp->thing_word = HEADER_FUN;
+        funp->next = NULL;
+        funp->fe = fe;
+        funp->num_free = 0;
+        funp->creator = erts_init_process_id;
+        funp->arity = arity;
+
+        op->op = genop_move_2;
+        op->arity = 2;
+        op->a[0].type = TAG_q;
+        op->a[0].val = lit;
+        op->a[1].type = TAG_x;
+        op->a[1].val = 0;
+    } else {
+        op->op = genop_i_make_fun_2;
+        op->arity = 2;
+        op->a[0].type = TAG_u;
+        op->a[0].val = (BeamInstr) fe;
+        op->a[1].type = TAG_u;
+        op->a[1].val = num_free;
+    }
+
     op->next = NULL;
     return op;
 }
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 9ff52c92b8..81531f6cc8 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -108,6 +108,7 @@ process_killer(void)
 		    erts_exit(0, "");
 		switch(j) {
 		case 'k':
+                    ASSERT(erts_init_process_id != ERTS_INVALID_PID);
                     /* Send a 'kill' exit signal from init process */
                     erts_proc_sig_send_exit(NULL, erts_init_process_id,
                                             rp->common.id, am_kill, NIL,
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 57c6c10c7f..5da7b43b9e 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -128,7 +128,7 @@ const Eterm etp_hole_marker = 0;
 
 static int modified_sched_thread_suggested_stack_size = 0;
 
-Eterm erts_init_process_id;
+Eterm erts_init_process_id = ERTS_INVALID_PID;
 
 /*
  * Note about VxWorks: All variables must be initialized by executable code,
@@ -2258,6 +2258,7 @@ erl_start(int argc, char **argv)
 
     erts_init_process_id = erl_first_process_otp("otp_ring0", NULL, 0,
                                                  boot_argc, boot_argv);
+	ASSERT(erts_init_process_id != ERTS_INVALID_PID);
 
     {
 	/*
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 243db4c734..706530023b 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -963,12 +963,16 @@ dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area)
                     }
                     erts_putc(to, to_arg, '\n');
                 }
-            } else if (is_export_header(w)) {
+            } else if (is_export_header(w) || is_fun_header(w)) {
                 dump_externally(to, to_arg, term);
                 erts_putc(to, to_arg, '\n');
             }
             size = 1 + header_arity(w);
             switch (w & _HEADER_SUBTAG_MASK) {
+            case FUN_SUBTAG:
+                ASSERT(((ErlFunThing*)(htop))->num_free == 0);
+                size += 1;
+                break;
             case MAP_SUBTAG:
                 if (is_flatmap_header(w)) {
                     size += 1 + flatmap_get_size(htop);
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 9c6dc3ff83..7e690fd870 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -332,6 +332,7 @@ constant_pools(Config) when is_list(Config) ->
     A = literals:a(),
     B = literals:b(),
     C = literals:huge_bignum(),
+    D = literals:funs(),
     process_flag(trap_exit, true),
     Self = self(),
 
@@ -345,7 +346,7 @@ constant_pools(Config) when is_list(Config) ->
     true = erlang:purge_module(literals),
     NoOldHeap ! done,
     receive
-        {'EXIT',NoOldHeap,{A,B,C}} ->
+        {'EXIT',NoOldHeap,{A,B,C,D}} ->
             ok;
         Other ->
             ct:fail({unexpected,Other})
@@ -362,7 +363,7 @@ constant_pools(Config) when is_list(Config) ->
     erlang:purge_module(literals),
     OldHeap ! done,
     receive
-	{'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 ->
+	{'EXIT',OldHeap,{A,B,C,D,[1,2,3|_]=Seq}} when length(Seq) =:= 16 ->
 	    ok
     end,
 
@@ -390,7 +391,7 @@ constant_pools(Config) when is_list(Config) ->
 	{'DOWN', Mon, process, Hib, Reason} ->
 	    {undef, [{no_module,
 		      no_function,
-		      [{A,B,C,[1,2,3|_]=Seq}], _}]} = Reason,
+		      [{A,B,C,D,[1,2,3|_]=Seq}], _}]} = Reason,
 	    16 = length(Seq)
     end,
     HeapSz = TotHeapSz, %% Ensure restored to hibernated state...
@@ -400,7 +401,9 @@ constant_pools(Config) when is_list(Config) ->
 no_old_heap(Parent) ->
     A = literals:a(),
     B = literals:b(),
-    Res = {A,B,literals:huge_bignum()},
+    C = literals:huge_bignum(),
+    D = literals:funs(),
+    Res = {A,B,C,D},
     Parent ! go,
     receive
         done ->
@@ -410,7 +413,9 @@ no_old_heap(Parent) ->
 old_heap(Parent) ->
     A = literals:a(),
     B = literals:b(),
-    Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)},
+    C = literals:huge_bignum(),
+    D = literals:funs(),
+    Res = {A,B,C,D,lists:seq(1, 16)},
     create_old_heap(),
     Parent ! go,
     receive
@@ -421,7 +426,9 @@ old_heap(Parent) ->
 hibernated(Parent) ->
     A = literals:a(),
     B = literals:b(),
-    Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)},
+    C = literals:huge_bignum(),
+    D = literals:funs(),
+    Res = {A,B,C,D,lists:seq(1, 16)},
     Parent ! go,
     erlang:hibernate(no_module, no_function, [Res]).
 
@@ -755,7 +762,8 @@ t_copy_literals_frags(Config) when is_list(Config) ->
                                           0, 1, 2, 3, 4, 5, 6, 7,
                                           8, 9,10,11,12,13,14,15,
                                           0, 1, 2, 3, 4, 5, 6, 7,
-                                          8, 9,10,11,12,13,14,15>>}]),
+                                          8, 9,10,11,12,13,14,15>>},
+                        {f, fun ?MODULE:all/0}]),
 
     {module, ?mod} = erlang:load_module(?mod, Bin),
     N = 6000,
@@ -796,6 +804,7 @@ literal_receiver() ->
             C = ?mod:c(),
             D = ?mod:d(),
             E = ?mod:e(),
+            F = ?mod:f(),
             literal_receiver();
         {Pid, sender_confirm} ->
             io:format("sender confirm ~w~n", [Pid]),
@@ -811,7 +820,8 @@ literal_sender(N, Recv) ->
                           ?mod:b(),
                           ?mod:c(),
                           ?mod:d(),
-                          ?mod:e()]},
+                          ?mod:e(),
+                          ?mod:f()]},
     literal_sender(N - 1, Recv).
 
 literal_switcher() ->
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 7c3b0ebe73..13c8b412b0 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -19,7 +19,8 @@
 %%
 
 -module(literals).
--export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]).
+-export([a/0,b/0,huge_bignum/0,funs/0,
+         binary/0,unused_binaries/0,bits/0]).
 -export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]).
 
 a() ->
@@ -108,3 +109,8 @@ msg2() -> {"hello","world"}.
 msg3() -> <<"halloj">>.
 msg4() -> #{ 1=> "hello", b => "world"}.
 msg5() -> {1,2,3,4,5,6}.
+
+funs() ->
+    %% Literal funs (in a non-literal list).
+    [fun ?MODULE:a/0,
+     fun() -> ok end].                          %No environment.
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index 73fe9b0d8f..f8a879182e 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -576,7 +576,7 @@ refc_dist(Config) when is_list(Config) ->
     process_flag(trap_exit, true),
     Pid = spawn_link(Node, fun() -> receive
                                         Fun when is_function(Fun) ->
-                                            2 = fun_refc(Fun),
+                                            3 = fun_refc(Fun),
                                             exit({normal,Fun}) end
                            end),
     F = fun() -> 42 end,
@@ -598,7 +598,7 @@ refc_dist_send(Node, F) ->
     Pid = spawn_link(Node, fun() -> receive
                                         {To,Fun} when is_function(Fun) ->
                                             wait_until(fun () ->
-                                                               2 =:= fun_refc(Fun)
+                                                               3 =:= fun_refc(Fun)
                                                        end),
                                             To ! Fun
                                     end
@@ -626,7 +626,7 @@ refc_dist_reg_send(Node, F) ->
                                    Me ! Ref,
                                    receive
                                        {Me,Fun} when is_function(Fun) ->
-                                           2 = fun_refc(Fun),
+                                           3 = fun_refc(Fun),
                                            Me ! Fun
                                    end
                            end),
@@ -806,11 +806,13 @@ verify_not_undef(Fun, Tag) ->
 	    ct:fail("tag ~w not defined in fun_info", [Tag]);
 	{Tag,_} -> ok
     end.
-	    
+
 id(X) ->
     X.
 
 spawn_call(Node, AFun) ->
+    Parent = self(),
+    Init = erlang:whereis(init),
     Pid = spawn_link(Node,
 		     fun() ->
 			     receive
@@ -821,8 +823,10 @@ spawn_call(Node, AFun) ->
 						_ -> lists:seq(0, Arity-1)
 					    end,
 				     Res = apply(Fun, Args),
-				     {pid,Creator} = erlang:fun_info(Fun, pid),
-				     Creator ! {result,Res}
+                     case erlang:fun_info(Fun, pid) of
+                        {pid,Init} -> Parent ! {result,Res};
+                        {pid,Creator} -> Creator ! {result,Res}
+                     end
 			     end
 		     end),
     Pid ! {AFun,AFun,AFun},
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index 837ab4e97e..af94fc79bc 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -1679,7 +1679,7 @@ make_fun() ->
     receive {Pid, Fun} -> Fun end.
 
 make_fun(Pid) ->
-    Pid ! {self(), fun make_fun/1}.
+    Pid ! {self(), fun (X) -> {X, Pid} end}.
 
 fun_pid(Fun) ->
     erlang:fun_info(Fun, pid).