Support sharing of fun entries in the runtime system

Before OTP 23, there had to be a one-to-one correspodence between
`make_fun2` instructions and fun entries.

In the OTP 23 runtime system, start keying the fun entries with the
explicit ("new") index included in the fun entry. That will allow
multiple `make_fun2` instructions to refer to the same entry in
the fun table.

This change is safe for code compiled by OTP R15B or later, because
the old and new indices are identical. The loader will refuse to
load code where the old and new indices are not equal unless the
code is known to be compiled with an OTP 23 compiler.

3 files changed, 62 insertions, 16 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 0de694f449..9add87d944 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -315,6 +315,7 @@ typedef struct LoaderState {
 				 * (or 0 if there is no on_load function)
 				 */
     int otp_20_or_higher;       /* Compiled with OTP 20 or higher */
+    unsigned max_opcode;        /* Highest opcode used in module */
 
     /*
      * Atom table.
@@ -1588,6 +1589,17 @@ static int
 read_lambda_table(LoaderState* stp)
 {
     unsigned int i;
+    unsigned int otp_22_or_lower;
+
+    /*
+     * Determine whether this module was compiled with OTP 22 or lower
+     * by looking at the max opcode number. The compiler in OTP 23 will
+     * always set the max opcode to the opcode for `swap` (whether
+     * actually used or not) so that a module compiled for OTP 23
+     * cannot be loaded in earlier versions.
+     */
+
+    otp_22_or_lower = stp->max_opcode < genop_swap_2;
 
     GetInt(stp, 4, stp->num_lambdas);
     if (stp->num_lambdas > stp->lambdas_allocated) {
@@ -1619,6 +1631,29 @@ read_lambda_table(LoaderState* stp)
 	GetInt(stp, 4, Index);
 	GetInt(stp, 4, stp->lambdas[i].num_free);
 	GetInt(stp, 4, OldUniq);
+
+        /*
+         * Fun entries are now keyed by the explicit ("new") index in
+         * the fun entry. That allows multiple make_fun2 instructions
+         * to share the same fun entry (when the `fun F/A` syntax is
+         * used). Before OTP 23, fun entries were keyed by the old
+         * index, which is the order of the entries in the fun
+         * chunk. Each make_fun2 needed to refer to its own fun entry.
+         *
+         * Modules compiled before OTP 23 can safely be loaded if the
+         * old index and the new index are equal. That is true for all
+         * modules compiled with OTP R15 and later.
+         */
+        if (otp_22_or_lower && i != Index) {
+            /*
+             * Compiled with a compiler before OTP R15B. The new indices
+             * are not reliable, so it is not safe to load this module.
+             */
+            LoadError2(stp, "please re-compile this module with an "
+                       ERLANG_OTP_RELEASE " compiler "
+                       "(old-style fun with indices: %d/%d)",
+                       i, Index);
+        }
 	fe = erts_put_fun_entry2(stp->module, OldUniq, i, stp->mod_md5,
 				 Index, arity-stp->lambdas[i].num_free);
 	stp->lambdas[i].fe = fe;
@@ -1839,7 +1874,6 @@ read_code_header(LoaderState* stp)
 {
     unsigned head_size;
     unsigned version;
-    unsigned opcode_max;
     int i;
 
     /*
@@ -1871,8 +1905,8 @@ read_code_header(LoaderState* stp)
     /*
      * Verify the number of the highest opcode used.
      */
-    GetInt(stp, 4, opcode_max);
-    if (opcode_max > MAX_GENERIC_OPCODE) {
+    GetInt(stp, 4, stp->max_opcode);
+    if (stp->max_opcode > MAX_GENERIC_OPCODE) {
 	LoadError2(stp,
 		   "This BEAM file was compiled for a later version"
 		   " of the run-time system than " ERLANG_OTP_RELEASE ".\n"
@@ -1880,7 +1914,7 @@ read_code_header(LoaderState* stp)
 		   ERLANG_OTP_RELEASE " compiler.\n"
 		   "  (Use of opcode %d; this emulator supports "
 		   "only up to %d.)",
-		   opcode_max, MAX_GENERIC_OPCODE);
+		   stp->max_opcode, MAX_GENERIC_OPCODE);
     }
 
     GetInt(stp, 4, stp->num_labels);
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index ca1e6bf5e7..257f9bf5b3 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -109,12 +109,12 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
 
     ASSERT(is_atom(mod));
     template.old_uniq = old_uniq;
-    template.old_index = old_index;
+    template.index = index;
     template.module = mod;
     erts_fun_write_lock();
     fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template);
     sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq));
-    fe->index = index;
+    fe->old_index = old_index;
     fe->arity = arity;
     refc = erts_refc_inctest(&fe->refc, 0);
     if (refc < 2) /* New or pending delete */
@@ -131,7 +131,7 @@ erts_get_fun_entry(Eterm mod, int uniq, int index)
 
     ASSERT(is_atom(mod));
     template.old_uniq = uniq;
-    template.old_index = index;
+    template.index = index;
     template.module = mod;
     erts_fun_read_lock();
     ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template);
@@ -287,15 +287,27 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg)
 static HashValue
 fun_hash(ErlFunEntry* obj)
 {
-    return (HashValue) (obj->old_uniq ^ obj->old_index ^ atom_val(obj->module));
+    return (HashValue) (obj->old_uniq ^ obj->index ^ atom_val(obj->module));
 }
 
 static int
 fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2)
 {
-    return !(obj1->module == obj2->module && 
+    /*
+     * OTP 23: Use 'index' (instead of 'old_index') when comparing fun
+     * entries. In OTP 23, multiple make_fun2 instructions may refer to the
+     * the same 'index' (for the wrapper function generated for the
+     * 'fun F/A' syntax).
+     *
+     * This is safe when loading code compiled with OTP R15 and later,
+     * because since R15 (2011), the 'index' has been reliably equal
+     * to 'old_index'. The loader refuses to load modules compiled before
+     * OTP R15.
+     */
+
+    return !(obj1->module == obj2->module &&
 	     obj1->old_uniq == obj2->old_uniq &&
-	     obj1->old_index == obj2->old_index);
+	     obj1->index == obj2->index);
 }
 
 static ErlFunEntry*
@@ -305,7 +317,7 @@ fun_alloc(ErlFunEntry* template)
 						  sizeof(ErlFunEntry));
 
     obj->old_uniq = template->old_uniq;
-    obj->old_index = template->old_index;
+    obj->index = template->index;
     obj->module = template->module;
     erts_refc_init(&obj->refc, -1);
     obj->address = unloaded_fun;
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 88cdcc2675..ad71828d72 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -907,7 +907,7 @@ tail_recur:
 	    hash = hash * FUNNY_NUMBER10 + num_free;
 	    hash = hash*FUNNY_NUMBER1 +
 		(atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue);
-	    hash = hash*FUNNY_NUMBER2 + funp->fe->old_index;
+	    hash = hash*FUNNY_NUMBER2 + funp->fe->index;
 	    hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq;
 	    if (num_free > 0) {
 		if (num_free > 1) {
@@ -1636,7 +1636,7 @@ make_hash2_helper(Eterm term_param, const int can_trap, Eterm* state_mref_write_
 		     atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue,
 		     HCONST);
 		UINT32_HASH_2
-		    (funp->fe->old_index, funp->fe->old_uniq, HCONST);
+		    (funp->fe->index, funp->fe->old_uniq, HCONST);
 		if (ctx.num_free == 0) {
 		    goto hash2_common;
 		} else {
@@ -2160,7 +2160,7 @@ make_internal_hash(Eterm term, Uint32 salt)
 		ErlFunThing* funp = (ErlFunThing *) fun_val(term);
 		Uint num_free = funp->num_free;
                 UINT32_HASH_2(num_free, funp->fe->module, HCONST_20);
-                UINT32_HASH_2(funp->fe->old_index, funp->fe->old_uniq, HCONST_21);
+                UINT32_HASH_2(funp->fe->index, funp->fe->old_uniq, HCONST_21);
 		if (num_free == 0) {
 		    goto pop_next;
 		} else {
@@ -2810,7 +2810,7 @@ tailrecur_ne:
 		    f1 = (ErlFunThing *) fun_val(a);
 		    f2 = (ErlFunThing *) fun_val(b);
 		    if (f1->fe->module != f2->fe->module ||
-			f1->fe->old_index != f2->fe->old_index ||
+			f1->fe->index != f2->fe->index ||
 			f1->fe->old_uniq != f2->fe->old_uniq ||
 			f1->num_free != f2->num_free) {
 			goto not_equal;
@@ -3405,7 +3405,7 @@ tailrecur_ne:
 		    if (diff != 0) {
 			RETURN_NEQ(diff);
 		    }
-		    diff = f1->fe->old_index - f2->fe->old_index;
+		    diff = f1->fe->index - f2->fe->index;
 		    if (diff != 0) {
 			RETURN_NEQ(diff);
 		    }