File 2191-Optimize-the-is_function-2-guard-test.patch of Package erlang
From 990976907841dd3122c82992ba9965ee313e988c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 21 Jan 2019 07:04:46 +0100
Subject: [PATCH] Optimize the is_function/2 guard test
The is_function2 instruction is executed surprisingly
frequently when running dialyzer or the compiler. It
cannot hurt to optimize it a little.
---
erts/emulator/beam/beam_emu.c | 14 +++++++
erts/emulator/beam/beam_load.c | 79 +++++++++++++++++++++++++++++++++-------
erts/emulator/beam/instrs.tab | 8 +++-
erts/emulator/beam/ops.tab | 9 +++--
erts/emulator/test/fun_SUITE.erl | 10 +++++
5 files changed, 102 insertions(+), 18 deletions(-)
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 6b34024a5a..4ef06464f4 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -404,6 +404,7 @@ static BeamInstr* apply_fun(Process* p, Eterm fun,
Eterm args, Eterm* reg) NOINLINE;
static Eterm new_fun(Process* p, Eterm* reg,
ErlFunEntry* fe, int num_free) NOINLINE;
+static int is_function2(Eterm Term, Uint arity);
static Eterm erts_gc_new_map(Process* p, Eterm* reg, Uint live,
Uint n, BeamInstr* ptr) NOINLINE;
static Eterm erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal,
@@ -2662,6 +2663,19 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
return make_fun(funp);
}
+static int
+is_function2(Eterm Term, Uint arity)
+{
+ if (is_fun(Term)) {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(Term);
+ return funp->arity == arity;
+ } else if (is_export(Term)) {
+ Export* exp = (Export *) (export_val(Term)[1]);
+ return exp->info.mfa.arity == arity;
+ }
+ return 0;
+}
+
static Eterm get_map_element(Eterm map, Eterm key)
{
Uint32 hx;
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 400a58a75c..7ff55e8927 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4297,6 +4297,72 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
return op;
}
+static GenOp*
+gen_is_function2(LoaderState* stp, GenOpArg Fail, GenOpArg Fun, GenOpArg Arity)
+{
+ GenOp* op;
+ int literal_arity = Arity.type == TAG_i;
+ int fun_is_reg = Fun.type == TAG_x || Fun.type == TAG_y;
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+
+ if (fun_is_reg &&literal_arity) {
+ /*
+ * Most common case. Fun in a register and arity
+ * is an integer literal.
+ */
+ if (Arity.val > MAX_ARG) {
+ /* Arity is negative or too big. */
+ op->op = genop_jump_1;
+ op->arity = 1;
+ op->a[0] = Fail;
+ return op;
+ } else {
+ op->op = genop_hot_is_function2_3;
+ op->arity = 3;
+ op->a[0] = Fail;
+ op->a[1] = Fun;
+ op->a[2].type = TAG_u;
+ op->a[2].val = Arity.val;
+ return op;
+ }
+ } else {
+ /*
+ * Handle extremely uncommon cases by a slower sequence.
+ */
+ GenOp* move_fun;
+ GenOp* move_arity;
+
+ NEW_GENOP(stp, move_fun);
+ NEW_GENOP(stp, move_arity);
+
+ move_fun->next = move_arity;
+ move_arity->next = op;
+
+ move_fun->arity = 2;
+ move_fun->op = genop_move_2;
+ move_fun->a[0] = Fun;
+ move_fun->a[1].type = TAG_x;
+ move_fun->a[1].val = 1022;
+
+ move_arity->arity = 2;
+ move_arity->op = genop_move_2;
+ move_arity->a[0] = Arity;
+ move_arity->a[1].type = TAG_x;
+ move_arity->a[1].val = 1023;
+
+ op->op = genop_cold_is_function2_3;
+ op->arity = 3;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_x;
+ op->a[1].val = 1022;
+ op->a[2].type = TAG_x;
+ op->a[2].val = 1023;
+ return move_fun;
+ }
+}
+
static GenOp*
tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
GenOpArg* Puts, GenOpArg S1, GenOpArg S2, GenOpArg S3,
@@ -4462,19 +4528,6 @@ is_empty_map(LoaderState* stp, GenOpArg Lit)
return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0;
}
-/*
- * Predicate to test whether the given literal is an export.
- */
-static int
-literal_is_export(LoaderState* stp, GenOpArg Lit)
-{
- Eterm term;
-
- ASSERT(Lit.type == TAG_q);
- term = stp->literals[Lit.val].term;
- return is_export(term);
-}
-
/*
* Pseudo predicate map_key_sort that will sort the Rest operand for
* map instructions as a side effect.
diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab
index df60e889f3..e55c4a112d 100644
--- a/erts/emulator/beam/instrs.tab
+++ b/erts/emulator/beam/instrs.tab
@@ -709,12 +709,18 @@ is_function(Fail, Src) {
}
}
-is_function2(Fail, Fun, Arity) {
+cold_is_function2(Fail, Fun, Arity) {
if (erl_is_function(c_p, $Fun, $Arity) != am_true ) {
$FAIL($Fail);
}
}
+hot_is_function2(Fail, Fun, Arity) {
+ if (!is_function2($Fun, $Arity)) {
+ $FAIL($Fail);
+ }
+}
+
is_integer(Fail, Src) {
if (is_not_integer($Src)) {
$FAIL($Fail);
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index ee99c9e563..8e730e42d6 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -719,11 +719,12 @@ is_boolean Fail=f ac => jump Fail
is_boolean f? xy
%hot
-is_function2 Fail=f Literal=q Arity | literal_is_export(Literal) =>
-is_function2 Fail=f c Arity => jump Fail
-is_function2 Fail=f Fun a => jump Fail
+is_function2 Fail=f Fun Arity => gen_is_function2(Fail, Fun, Arity)
-is_function2 f? S s
+%cold
+cold_is_function2 f? x x
+%hot
+hot_is_function2 f? S t
# Allocating & initializing.
allocate Need Regs | init Y => allocate_init Need Regs Y
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index f8a879182e..4042b58ff2 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -710,6 +710,16 @@ t_is_function2(Config) when is_list(Config) ->
bad_arity({}),
bad_arity({a,b}),
bad_arity(self()),
+
+ %% Bad arity argument in guard test.
+ Fun = fun erlang:abs/1,
+ ok = if
+ is_function(Fun, -1) -> error;
+ is_function(Fun, 256) -> error;
+ is_function(Fun, a) -> error;
+ is_function(Fun, Fun) -> error;
+ true -> ok
+ end,
ok.
bad_arity(A) ->
--
2.16.4
