OTP-8240 Improved GC performance after BIF/NIF call when a lot of heap

          fragments was created. This will mainly benefit NIFs that return
          large compound terms.

1 files changed, 126 insertions, 39 deletions

diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index f380e7732e..24887b3dea 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -1013,6 +1013,34 @@ term_to_binary_2(Process* p, Eterm Term, Eterm Flags)
     return erts_term_to_binary(p, Term, level, flags);
 }
 
+static uLongf binary2term_uncomp_size(byte* data, Sint size)
+{
+    z_stream stream;
+    int err;
+    const uInt chunk_size = 64*1024;  /* Ask tmp-alloc about a suitable size? */
+    void* tmp_buf = erts_alloc(ERTS_ALC_T_TMP, chunk_size);
+    uLongf uncomp_size = 0;
+
+    stream.next_in = (Bytef*)data;
+    stream.avail_in = (uInt)size;
+    stream.next_out = tmp_buf;
+    stream.avail_out = (uInt)chunk_size;
+
+    erl_zlib_alloc_init(&stream);
+
+    err = inflateInit(&stream);
+    if (err == Z_OK) {
+	while ((err = inflate(&stream, Z_NO_FLUSH)) == Z_OK) {
+	    uncomp_size += chunk_size - stream.avail_out;
+	    stream.next_out = tmp_buf;
+	    stream.avail_out = chunk_size;
+	}
+	inflateEnd(&stream);
+    }
+    erts_free(ERTS_ALC_T_TMP, tmp_buf);
+    return err == Z_STREAM_END ? uncomp_size : 0;
+}
+
 static ERTS_INLINE Sint
 binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
 {
@@ -1036,10 +1064,18 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
 	state->extp = bytes;
     }
     else  {
-	uLongf dest_len = get_int32(bytes+1);
-	state->extp = erts_alloc(ERTS_ALC_T_TMP, dest_len);
+	uLongf dest_len = (Uint32) get_int32(bytes+1);
+	bytes += 5;
+	size -= 5;	
+	if (dest_len > 32*1024*1024
+	    || (state->extp = erts_alloc_fnf(ERTS_ALC_T_TMP, dest_len)) == NULL) {
+	    if (dest_len != binary2term_uncomp_size(bytes, size)) {
+		goto error;
+	    }
+	    state->extp = erts_alloc(ERTS_ALC_T_TMP, dest_len);
+	}
 	state->exttmp = 1;
-	if (erl_zlib_uncompress(state->extp, &dest_len, bytes+5, size-5) != Z_OK)
+	if (erl_zlib_uncompress(state->extp, &dest_len, bytes, size) != Z_OK)
 	    goto error;
 	size = (Sint) dest_len;
     }
@@ -1840,9 +1876,80 @@ is_external_string(Eterm list, int* p_is_string)
     return len;
 }
 
+/* Assumes that the ones to undo are preluding the lists. */ 
+static void
+undo_offheap_in_area(ErlOffHeap* off_heap, Eterm* start, Eterm* end)
+{
+    const Uint area_sz = (end - start) * sizeof(Eterm);
+    struct proc_bin* mso;
+    struct proc_bin** mso_nextp = NULL;
+#ifndef HYBRID /* FIND ME! */
+    struct erl_fun_thing* funs;
+    struct erl_fun_thing** funs_nextp = NULL;
+#endif
+    struct external_thing_* ext;
+    struct external_thing_** ext_nextp = NULL;
+
+    for (mso = off_heap->mso; ; mso=mso->next) {
+	if (!in_area(mso, start, area_sz)) {
+	    if (mso_nextp != NULL) {
+		*mso_nextp = NULL;
+		erts_cleanup_mso(off_heap->mso);
+		off_heap->mso = mso;
+	    }
+	    break;
+	}
+	mso_nextp = &mso->next;
+    }    
+
+#ifndef HYBRID /* FIND ME! */
+    for (funs = off_heap->funs; ; funs=funs->next) {
+	if (!in_area(funs, start, area_sz)) {
+	    if (funs_nextp != NULL) {
+		*funs_nextp = NULL;
+		erts_cleanup_funs(off_heap->funs);
+		off_heap->funs = funs;
+	    }
+	    break;
+	}
+	funs_nextp = &funs->next;
+    }    
+#endif
+    for (ext = off_heap->externals; ; ext=ext->next) {
+	if (!in_area(ext, start, area_sz)) {
+	    if (ext_nextp != NULL) {
+		*ext_nextp = NULL;
+		erts_cleanup_externals(off_heap->externals);
+		off_heap->externals = ext;
+	    }
+	    break;
+	}
+	ext_nextp = &ext->next;
+    }
+
+    /* Assert that the ones to undo were indeed preluding the lists. */ 
+#ifdef DEBUG
+    for (mso = off_heap->mso; mso != NULL; mso=mso->next) {
+	ASSERT(!in_area(mso, start, area_sz));
+    }    
+# ifndef HYBRID /* FIND ME! */
+    for (funs = off_heap->funs; funs != NULL; funs=funs->next) {
+	ASSERT(!in_area(funs, start, area_sz));
+    }    
+# endif
+    for (ext = off_heap->externals; ext != NULL; ext=ext->next) {
+	ASSERT(!in_area(ext, start, area_sz));
+    }    
+#endif /* DEBUG */
+}
+
+/* Decode term from external format into *objp.
+** On failure return NULL and (R13B04) *hpp will be unchanged.
+*/
 static byte*
 dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp)
 {
+    Eterm* hp_saved = *hpp;
     int n;
     register Eterm* hp = *hpp;	/* Please don't take the address of hp */
     Eterm* next = objp;
@@ -2043,7 +2150,7 @@ dec_term_atom_common:
 	    ep = dec_pid(edep, hpp, ep, off_heap, objp);
 	    hp = *hpp;
 	    if (ep == NULL) {
-		return NULL;
+		goto error;
 	    }
 	    break;
 	case PORT_EXT:
@@ -2278,7 +2385,7 @@ dec_term_atom_common:
 		ep = dec_term(edep, hpp, ep, off_heap, &temp);
 		hp = *hpp;
 		if (ep == NULL) {
-		    return NULL;
+		    goto error;
 		}
 		if (!is_small(temp)) {
 		    goto error;
@@ -2308,8 +2415,6 @@ dec_term_atom_common:
 		Sint old_index;
 		unsigned num_free;
 		int i;
-		Eterm* temp_hp;
-		Eterm** hpp = &temp_hp;
 		Eterm temp;
 
 		ep += 4;	/* Skip total size in bytes */
@@ -2321,23 +2426,16 @@ dec_term_atom_common:
 		num_free = get_int32(ep);
 		ep += 4;
 		hp += ERL_FUN_SIZE;
-		if (num_free > 0) {
-		    /* Don't leave a hole in case we fail */
-		    *hp = make_pos_bignum_header(num_free-1);
-		}
 		hp += num_free;
-		*hpp = hp;
 		funp->thing_word = HEADER_FUN;
 		funp->num_free = num_free;
-		funp->creator = NIL; /* Don't leave a hole in case we fail */
 		*objp = make_fun(funp);
 
 		/* Module */
-		if ((ep = dec_atom(edep, ep, &temp)) == NULL) {
+		if ((ep = dec_atom(edep, ep, &module)) == NULL) {
 		    goto error;
 		}
-		module = temp;
-
+		*hpp = hp;
 		/* Index */
 		if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) {
 		    goto error;
@@ -2394,17 +2492,11 @@ dec_term_atom_common:
 		Sint old_index;
 		unsigned num_free;
 		int i;
-		Eterm* temp_hp;
-		Eterm** hpp = &temp_hp;
 		Eterm temp;
 
 		num_free = get_int32(ep);
 		ep += 4;
 		hp += ERL_FUN_SIZE;
-		if (num_free > 0) {
-		    /* Don't leave a hole in the heap in case we fail. */
-		    *hp = make_pos_bignum_header(num_free-1);
-		}
 		hp += num_free;
 		*hpp = hp;
 		funp->thing_word = HEADER_FUN;
@@ -2412,23 +2504,16 @@ dec_term_atom_common:
 		*objp = make_fun(funp);
 
 		/* Creator pid */
-		switch(*ep) {
-		case PID_EXT:
-		    ep = dec_pid(edep, hpp, ++ep, off_heap, &funp->creator);
-		    if (ep == NULL) {
-			funp->creator = NIL; /* Don't leave a hole in the heap */
-			goto error;
-		    }
-		    break;
-		default:
+		if (*ep != PID_EXT 
+		    || (ep = dec_pid(edep, hpp, ++ep, off_heap,
+				     &funp->creator))==NULL) { 
 		    goto error;
 		}
 
 		/* Module */
-		if ((ep = dec_atom(edep, ep, &temp)) == NULL) {
+		if ((ep = dec_atom(edep, ep, &module)) == NULL) {
 		    goto error;
 		}
-		module = temp;
 
 		/* Index */
 		if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) {
@@ -2455,7 +2540,6 @@ dec_term_atom_common:
 		funp->next = off_heap->funs;
 		off_heap->funs = funp;
 #endif
-
 		old_uniq = unsigned_val(temp);
 
 		funp->fe = erts_put_fun_entry(module, old_uniq, old_index);
@@ -2474,12 +2558,15 @@ dec_term_atom_common:
 	    }
 	default:
 	error:
-	    /*
-	     * Be careful to return the updated heap pointer, to avoid
-	     * that the caller wipes out binaries or other off-heap objects
-	     * that may have been linked into the process.
+	    /* UNDO:
+	     * Must unlink all off-heap objects that may have been
+	     * linked into the process. 
 	     */
-	    *hpp = hp;
+	    if (hp < *hpp) { /* Sometimes we used hp and sometimes *hpp */
+		hp = *hpp;   /* the largest must be the freshest */
+	    }
+	    undo_offheap_in_area(off_heap, hp_saved, hp);
+	    *hpp = hp_saved;
 	    return NULL;
 	}
     }