erts: Optimize erlang:check_process_code

by ignoring literals.

erts_internal:check_process_code will be called again anyway
(with option {copy_literals, true}) before the module is actually purged.
No need to check literals twice.

7 files changed, 54 insertions, 63 deletions

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 892b2d16c2..a000935388 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -38,7 +38,7 @@
 #include "erl_thr_progress.h"
 
 static void set_default_trace_pattern(Eterm module);
-static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
+static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp);
 static void delete_code(Module* modp);
 static void decrement_refc(BeamCodeHeader*);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -426,7 +426,7 @@ check_old_code_1(BIF_ALIST_1)
 }
 
 Eterm
-erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
+erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp)
 {
     Module* modp;
     Eterm res;
@@ -441,7 +441,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
     if (!modp)
 	return am_false;
     erts_rlock_old_code(code_ix);
-    res = modp->old.code_hdr ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
+    res = (!modp->old.code_hdr ? am_false :
+           check_process_code(c_p, modp, flags, redsp));
     erts_runlock_old_code(code_ix);
 
     return res;
@@ -450,49 +451,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
 BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2)
 {
     int reds = 0;
+    Uint flags;
     Eterm res;
-    Eterm olist = BIF_ARG_2;
-    int allow_gc = 1;
 
     if (is_not_atom(BIF_ARG_1))
 	goto badarg;
 
-    while (is_list(olist)) {
-	Eterm *lp = list_val(olist);
-	Eterm opt = CAR(lp);
-	if (is_tuple(opt)) {
-	    Eterm* tp = tuple_val(opt);
-	    switch (arityval(tp[0])) {
-	    case 2:
-		switch (tp[1]) {
-		case am_allow_gc:
-		    switch (tp[2]) {
-		    case am_false:
-			allow_gc = 0;
-			break;
-		    case am_true:
-			allow_gc = 1;
-			break;
-		    default:
-			goto badarg;
-		    }
-		    break;
-		default:
-		    goto badarg;
-		}
-		break;
-	    default:
-		goto badarg;
-	    }
-	}
-	else
-	    goto badarg;
-	olist = CDR(lp);
+    if (is_not_small(BIF_ARG_2))
+        goto badarg;
+
+    flags = unsigned_val(BIF_ARG_2);
+    if (flags & ~ERTS_CPC_ALL) {
+        goto badarg;
     }
-    if (is_not_nil(olist))
-	goto badarg;
 
-    res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds);
+    res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds);
 
     ASSERT(is_value(res));
 
@@ -739,7 +712,7 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
 
 
 static Eterm
-check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
+check_process_code(Process* rp, Module* modp, Uint flags, int *redsp)
 {
     BeamInstr* start;
     char* literals;
@@ -852,6 +825,12 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	/* Check heap, stack etc... */
 	if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
 	    goto try_gc;
+        if (!(flags & ERTS_CPC_COPY_LITERALS)) {
+            /* Process ok. May contain old literals but we will be called
+             * again before module is purged.
+             */
+            return am_false;
+        }
 	if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
 	    rp->freason = EXC_NULL;
 	    rp->fvalue = NIL;
@@ -919,7 +898,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	if ((done_gc & need_gc) == need_gc)
 	    return am_true;
 
-	if (!allow_gc)
+	if (!(flags & ERTS_CPC_ALLOW_GC))
 	    return am_aborted;
 
 	need_gc &= ~done_gc;
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 9495436ba6..d36d866b2f 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -10055,7 +10055,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
 	case ERTS_PSTT_CPC:
 	    st_res = erts_check_process_code(c_p,
 					     st->arg[0],
-					     st->arg[1] == am_true,
+                                             unsigned_val(st->arg[1]),
 					     &reds);
 	    if (is_non_value(st_res)) {
 		/* Needed gc, but gc was disabled */
@@ -10219,7 +10219,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
     case am_check_process_code:
 	if (is_not_atom(st->arg[0]))
 	    goto badarg;
-	if (st->arg[1] != am_true && st->arg[1] != am_false)
+	if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL))
 	    goto badarg;
 	noproc_res = am_false;
 	st->type = ERTS_PSTT_CPC;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index bbf684d49d..3f5925765d 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -985,7 +985,10 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg);
 Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
 
 /* beam_bif_load.c */
-Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp);
+#define ERTS_CPC_ALLOW_GC      (1 << 0)
+#define ERTS_CPC_COPY_LITERALS (1 << 1)
+#define ERTS_CPC_ALL           (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS)
+Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp);
 
 typedef struct {
     Eterm *ptr;
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
index c5aec6bb25..ca6c8570ed 100644
--- a/erts/preloaded/ebin/erts_code_purger.beam
+++ b/erts/preloaded/ebin/erts_code_purger.beam
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 4c66171965..d3d990519d 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
index 791ef72f13..e492ba1812 100644
--- a/erts/preloaded/src/erts_code_purger.erl
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -283,8 +283,9 @@ cpc_sched_kill(Pid,
 		       killed = true}.
 
 cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) ->
-    erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
-					 {allow_gc, AllowGc}]).
+    erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
+						{allow_gc, AllowGc},
+						{copy_literals, true}]).
 
 cpc_request_gc(CpcS, [Pid|Pids]) ->
     cpc_request(CpcS, Pid, true),
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index e32d65ff59..84dedab930 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -202,22 +202,24 @@ port_info(_Result, _Item) ->
 request_system_task(_Pid, _Prio, _Request) ->
     erlang:nif_error(undefined).
 
--spec check_process_code(Module, OptionList) -> boolean() when
+-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)).
+-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)).
+
+-spec check_process_code(Module, Flags) -> boolean() when
       Module :: module(),
-      Option :: {allow_gc, boolean()},
-      OptionList :: [Option].
-check_process_code(_Module, _OptionList) ->
+      Flags :: non_neg_integer().
+check_process_code(_Module, _Flags) ->
     erlang:nif_error(undefined).
 
 -spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when
       Pid :: pid(),
       Module :: module(),
       RequestId :: term(),
-      Option :: {async, RequestId} | {allow_gc, boolean()},
+      Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()},
       OptionList :: [Option],
       CheckResult :: boolean() | aborted.
 check_process_code(Pid, Module, OptionList)  ->
-    {Async, AllowGC} = get_cpc_opts(OptionList, sync, true),
+    {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC),
     case Async of
 	{async, ReqId} ->
 	    {priority, Prio} = erlang:process_info(erlang:self(),
@@ -227,13 +229,12 @@ check_process_code(Pid, Module, OptionList)  ->
 					      {check_process_code,
 					       ReqId,
 					       Module,
-					       AllowGC}),
+					       Flags}),
 	    async;
 	sync ->
 	    case Pid == erlang:self() of
 		true ->
-		    erts_internal:check_process_code(Module,
-						     [{allow_gc, AllowGC}]);
+		    erts_internal:check_process_code(Module, Flags);
 		false ->
 		    {priority, Prio} = erlang:process_info(erlang:self(),
 							   priority),
@@ -243,7 +244,7 @@ check_process_code(Pid, Module, OptionList)  ->
 						      {check_process_code,
 						       ReqId,
 						       Module,
-						       AllowGC}),
+						       Flags}),
 		    receive
 			{check_process_code, ReqId, CheckResult} ->
 			    CheckResult
@@ -251,13 +252,20 @@ check_process_code(Pid, Module, OptionList)  ->
 	    end
     end.
 
-% gets async and allow_gc opts and verify valid option list
-get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) ->
-    get_cpc_opts(Options, AsyncTuple, AllowGC);
-get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) ->
-    get_cpc_opts(Options, Async, AllowGC);
-get_cpc_opts([], Async, AllowGC) ->
-    {Async, AllowGC}.
+% gets async and flag opts and verify valid option list
+get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) ->
+    get_cpc_opts(Options, AsyncTuple, Flags);
+get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) ->
+    get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC));
+get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) ->
+    get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit));
+get_cpc_opts([], Async, Flags) ->
+    {Async, Flags}.
+
+cpc_flags(OldFlags, Bit, true) ->
+    OldFlags bor Bit;
+cpc_flags(OldFlags, Bit, false) ->
+    OldFlags band (bnot Bit).
 
 -spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
       Module :: module(),