Merge pull request #7894 from jhogberg/john/erts/share-external-funs

erts: Share external funs globally

erts/emulator/beam/beam_file.c

@@ -759,6 +759,11 @@ static int parse_decompressed_literals(BeamFile *beam,
         ErlHeapFragment *fragments;
         Eterm value;
 
+#ifdef DEBUG
+        erts_literal_area_t purge_area;
+        INITIALIZE_LITERAL_PURGE_AREA(purge_area);
+#endif
+
         LoadAssert(beamreader_read_i32(&reader, &ext_size));
         LoadAssert(beamreader_read_bytes(&reader, ext_size, &ext_data));
         term_size = erts_decode_ext_size(ext_data, ext_size);
@@ -774,14 +779,24 @@ static int parse_decompressed_literals(BeamFile *beam,
             erts_factory_close(&factory);
 
             LoadAssert(!is_non_value(value));
+            ASSERT(size_object_litopt(value, &purge_area) > 0);
 
             heap_size += erts_used_frag_sz(factory.heap_frags);
             fragments = factory.heap_frags;
         } else {
             erts_factory_dummy_init(&factory);
             value = erts_decode_ext(&factory, &ext_data, 0);
+
+            /* erts_decode_ext may return terms that are (or contain) global
+             * literals, for instance export funs or the empty tuple. As these
+             * are singleton values that belong to everyone, they can safely be
+             * returned without being copied into a fragment.
+             *
+             * (Note that erts_decode_ext_size does not include said term in
+             * the decoded size) */
             LoadAssert(!is_non_value(value));
-            ASSERT(is_immed(value));
+            ASSERT(size_object_litopt(value, &purge_area) == 0);
+
             fragments = NULL;
         }
 
@@ -1269,16 +1284,24 @@ static void move_literal_entries(BeamFile_LiteralEntry *entries, int count,
     int i;
 
     for (i = 0; i < count; i++) {
-        if (is_not_immed(entries[i].value)) {
-            ASSERT(entries[i].heap_fragments != NULL);
+        if (entries[i].heap_fragments != NULL) {
+            Eterm value = entries[i].value;
+
+#ifdef DEBUG
+            erts_literal_area_t purge_area;
+            INITIALIZE_LITERAL_PURGE_AREA(purge_area);
+#endif
+
+            ASSERT(size_object_litopt(value, &purge_area) > 0);
 
             erts_move_multi_frags(hpp, oh,
-                                  entries[i].heap_fragments, &entries[i].value,
+                                  entries[i].heap_fragments, &value,
                                   1, 1);
-            ASSERT(erts_is_literal(entries[i].value, ptr_val(entries[i].value)));
+            ASSERT(erts_is_literal(value, ptr_val(value)));
 
             free_literal_fragment(entries[i].heap_fragments);
             entries[i].heap_fragments = NULL;
+            entries[i].value = value;
         }
 
         ASSERT(entries[i].heap_fragments == NULL);

erts/emulator/beam/bif.c

@@ -4152,8 +4152,6 @@ BIF_RETTYPE ref_to_list_1(BIF_ALIST_1)
 
 BIF_RETTYPE make_fun_3(BIF_ALIST_3)
 {
-    ErlFunThing *funp;
-    Eterm *hp;
     Export *ep;
     Sint arity;
 
@@ -4168,12 +4166,8 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
         BIF_ERROR(BIF_P, BADARG);
     }
 
-    hp = HAlloc(BIF_P, ERL_FUN_SIZE);
-
     ep = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
-    funp = erts_new_export_fun_thing(&hp, ep, arity);
-
-    BIF_RET(make_fun(funp));
+    BIF_RET(ep->lambda);
 }
 
 BIF_RETTYPE fun_to_list_1(BIF_ALIST_1)

erts/emulator/beam/erl_fun.c

@@ -296,28 +296,6 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
     ERTS_THR_WRITE_MEMORY_BARRIER;
 }
 
-
-ErlFunThing *erts_new_export_fun_thing(Eterm **hpp, Export *exp, int arity)
-{
-    ErlFunThing *funp;
-
-    funp = (ErlFunThing*)(*hpp);
-    *hpp += ERL_FUN_SIZE;
-
-    funp->thing_word = MAKE_FUN_HEADER(arity, 0, 1);
-    funp->entry.exp = exp;
-    funp->next = NULL;
-
-#ifdef DEBUG
-    {
-        const ErtsCodeMFA *mfa = &exp->info.mfa;
-        ASSERT(arity == mfa->arity);
-    }
-#endif
-
-    return funp;
-}
-
 ErlFunThing *erts_new_local_fun_thing(Process *p, ErlFunEntry *fe,
                                       int arity, int num_free)
 {

erts/emulator/beam/erl_fun.h

@@ -89,7 +89,6 @@ typedef struct erl_fun_thing {
  * C99-style flexible array */
 #define ERL_FUN_SIZE ((sizeof(ErlFunThing)/sizeof(Eterm)))
 
-ErlFunThing *erts_new_export_fun_thing(Eterm **hpp, Export *exp, int arity);
 ErlFunThing *erts_new_local_fun_thing(Process *p,
                                       ErlFunEntry *fe,
                                       int arity,

erts/emulator/beam/erl_process_dump.c

@@ -900,6 +900,12 @@ dump_literals(fmtfn_t to, void *to_arg)
     for (idx = 0; idx < erts_num_persistent_areas; idx++) {
         dump_module_literals(to, to_arg, erts_persistent_areas[idx]);
     }
+
+    for (ErtsLiteralArea *lambda_area = erts_get_next_lambda_lit_area(NULL);
+         lambda_area != NULL;
+         lambda_area = erts_get_next_lambda_lit_area(lambda_area)) {
+        dump_module_literals(to, to_arg, lambda_area);
+    }
 }
 
 static void

erts/emulator/beam/export.c

@@ -34,6 +34,14 @@
 
 #define EXPORT_HASH(m,f,a) ((atom_val(m) * atom_val(f)) ^ (a))
 
+#ifndef DEBUG
+#  define SHARED_LAMBDA_INITIAL_SIZE EXPORT_INITIAL_SIZE
+#  define SHARED_LAMBDA_EXPAND_SIZE 512
+#else
+#  define SHARED_LAMBDA_INITIAL_SIZE 256
+#  define SHARED_LAMBDA_EXPAND_SIZE 16
+#endif
+
 #ifdef DEBUG
 #  define IF_DEBUG(x) x
 #else
@@ -49,6 +57,18 @@ static erts_atomic_t total_entries_bytes;
  */
 erts_mtx_t export_staging_lock;
 
+/* Bump allocator for globally shared external funs, allocating them in
+ * reasonably large chunks to simplify crash dumping and avoid fragmenting the
+ * literal heap too much.
+ *
+ * This is protected by the export staging lock. */
+struct lambda_chunk {
+    struct lambda_chunk *next;
+    Eterm *hp;
+
+    ErtsLiteralArea area;
+} *lambda_chunk = NULL;
+
 struct export_entry
 {
     IndexSlot slot; /* MUST BE LOCATED AT TOP OF STRUCT!!! */
@@ -109,6 +129,72 @@ export_cmp(struct export_entry* tmpl_e, struct export_entry* obj_e)
 	     tmpl->info.mfa.arity == obj->info.mfa.arity);
 }
 
+ErtsLiteralArea *erts_get_next_lambda_lit_area(ErtsLiteralArea *prev)
+{
+    struct lambda_chunk *next;
+
+    ASSERT(ERTS_IS_CRASH_DUMPING);
+
+    if (prev != NULL) {
+        struct lambda_chunk *chunk = ErtsContainerStruct(prev,
+                                                         struct lambda_chunk,
+                                                         area);
+        next = chunk->next;
+
+        if (next == NULL) {
+            return NULL;
+        }
+    } else {
+        next = lambda_chunk;
+    }
+
+    next->area.end = next->hp;
+    return &next->area;
+}
+
+static void expand_shared_lambda_area(Uint count)
+{
+    struct lambda_chunk *chunk;
+    Uint heap_size;
+
+    ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&export_staging_lock));
+
+    heap_size = count * ERL_FUN_SIZE;
+    chunk = erts_alloc(ERTS_ALC_T_LITERAL,
+                       sizeof(struct lambda_chunk) +
+                        (heap_size - 1) * sizeof(Eterm));
+    chunk->hp = &chunk->area.start[0];
+    chunk->area.end = &chunk->hp[heap_size];
+    chunk->area.off_heap = NULL;
+    chunk->next = lambda_chunk;
+
+    lambda_chunk = chunk;
+}
+
+static void create_shared_lambda(Export *export)
+{
+    ErlFunThing *lambda;
+
+    ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&export_staging_lock));
+
+    ASSERT((lambda_chunk->hp <= lambda_chunk->area.end &&
+            lambda_chunk->hp >= lambda_chunk->area.start) &&
+           ((lambda_chunk->area.end - lambda_chunk->hp) % ERL_FUN_SIZE) == 0);
+    if (lambda_chunk->hp == lambda_chunk->area.end) {
+        expand_shared_lambda_area(SHARED_LAMBDA_EXPAND_SIZE);
+    }
+
+    lambda = (ErlFunThing*)lambda_chunk->hp;
+    lambda_chunk->hp += ERL_FUN_SIZE;
+
+    lambda->thing_word = MAKE_FUN_HEADER(export->info.mfa.arity, 0, 1);
+    lambda->entry.exp = export;
+    lambda->next = NULL;
+
+    export->lambda = make_fun(lambda);
+
+    erts_set_literal_tag(&export->lambda, (Eterm*)lambda, ERL_FUN_SIZE);
+}
 
 static struct export_entry*
 export_alloc(struct export_entry* tmpl_e)
@@ -131,6 +217,8 @@ export_alloc(struct export_entry* tmpl_e)
         obj->bif_number = -1;
         obj->is_bif_traced = 0;
 
+        create_shared_lambda(obj);
+
         sys_memset(&obj->trampoline, 0, sizeof(obj->trampoline));
 
         if (BeamOpsAreInitialized()) {
@@ -197,6 +285,16 @@ init_export_table(void)
 	erts_index_init(ERTS_ALC_T_EXPORT_TABLE, &export_tables[i], "export_list",
 			EXPORT_INITIAL_SIZE, EXPORT_LIMIT, f);
     }
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+    export_staging_lock();
+#endif
+
+    expand_shared_lambda_area(SHARED_LAMBDA_INITIAL_SIZE);
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+    export_staging_unlock();
+#endif
 }
 
 static struct export_entry* init_template(struct export_templ* templ,

erts/emulator/beam/export.h

@@ -57,6 +57,10 @@ typedef struct export_
     /* Non-zero if this is a BIF that's traced. */
     int is_bif_traced;
 
+    /* Globally shared external fun for this export entry. This is always a
+     * literal. */
+    Eterm lambda;
+
     /* This is a small trampoline function that can be used for lazy code
      * loading, global call tracing, and so on. It's only valid when
      * addresses points to it and should otherwise be left zeroed.

erts/emulator/beam/external.c

@@ -4905,7 +4905,6 @@ dec_term(ErtsDistExternal *edep,
             }
         case EXPORT_EXT:
             {
-                ErlFunThing *funp;
                 Export *export;
                 Eterm mod;
                 Eterm name;
@@ -4937,9 +4936,7 @@ dec_term(ErtsDistExternal *edep,
                 }
 
                 export = erts_export_get_or_make_stub(mod, name, arity);
-                funp = erts_new_export_fun_thing(&factory->hp, export, arity);
-                hp = factory->hp;
-                *objp = make_fun(funp);
+                *objp = export->lambda;
             }
             break;
 	case MAP_EXT:
@@ -5185,8 +5182,19 @@ dec_term(ErtsDistExternal *edep,
         }
     }
 
-    ASSERT(hp <= factory->hp_end
-           || (factory->mode == FACTORY_CLOSED && is_immed(*dbg_resultp)));
+#ifdef DEBUG
+    if (factory->mode == FACTORY_CLOSED) {
+        erts_literal_area_t purge_area;
+        INITIALIZE_LITERAL_PURGE_AREA(purge_area);
+
+        /* When we've got a dummy factory we should only be able to produce
+         * global literals and immediates. */
+        ASSERT(size_object_litopt(*dbg_resultp, &purge_area) == 0);
+    } else {
+        ASSERT(hp <= factory->hp_end);
+    }
+#endif
+
     factory->hp = hp;
     /*
      * From here on factory may produce (more) heap fragments
@@ -6016,22 +6024,37 @@ decoded_size(const byte *ep, const byte* endp, int internal_tags, B2TContext* ct
 	    CHKSIZE(1);
 	    n = *ep++;
             ADDTERMS(n);
-	    heap_size += n + 1;
+            /* When decoding the empty tuple we always use the canonical
+             * global literal, so it won't occupy any heap space in the block
+             * we're decoding to. */
+            if (n > 0) {
+                heap_size += n + 1;
+            }
 	    break;
 	case LARGE_TUPLE_EXT:
 	    CHKSIZE(4);
 	    n = get_uint32(ep);
 	    ep += 4;
             CHKSIZE(n); /* Fail faster if the binary is too short. */
 	    ADDTERMS(n);
-	    heap_size += n + 1;
+            /* See SMALL_TUPLE_EXT. */
+            if (n > 0) {
+                heap_size += n + 1;
+            }
 	    break;
 	case MAP_EXT:
 	    CHKSIZE(4);
 	    n = get_uint32(ep);
 	    ep += 4;
             if (n <= MAP_SMALL_MAP_LIMIT) {
-                heap_size += 3 + n + 1 + n;
+                heap_size += 3 + n;
+
+                /* When decoding the empty tuple we always use the canonical
+                 * global literal, so it won't occupy any heap space in the
+                 * block we're decoding to. */
+                if (n > 0) {
+                    heap_size += 1 + n;
+                }
 #if defined(ARCH_64)
             } else if ((n >> 31) != 0) {
                 /* Avoid overflow by limiting the number of elements in
@@ -6095,8 +6118,10 @@ decoded_size(const byte *ep, const byte* endp, int internal_tags, B2TContext* ct
 	    }
 	    break;
 	case EXPORT_EXT:
-	    ADDTERMS(3);
-	    heap_size += ERL_FUN_SIZE;
+            /* When decoding these we always use the canonical fun from the
+             * export entry, so they won't occupy any heap space in the block
+             * we're decoding to. */
+            ADDTERMS(3);
 	    break;
 	case NEW_FUN_EXT:
 	    {

erts/emulator/beam/global.h

@@ -1005,6 +1005,12 @@ void erts_lookup_function_info(FunctionInfo* fi,
 extern ErtsLiteralArea** erts_dump_lit_areas;
 extern Uint erts_dump_num_lit_areas;
 
+/* export.c */
+
+/** @brief Iterates through the literal areas for canonical lambdas. This is
+ * destructive and can only be used for crash dumping. */
+ErtsLiteralArea *erts_get_next_lambda_lit_area(ErtsLiteralArea *prev);
+
 /* break.c */
 void init_break_handler(void);
 void erts_set_ignore_break(void);