Make iolist_size/1 yield

The iolist_size/1 function did not yield even if the input list was
very long and a call to the function did only consume a single
reduction. This commit fixes these problems.

5 files changed, 293 insertions, 21 deletions

diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index ff7db0e742..1645ad6cf8 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -2365,7 +2365,7 @@ accumulate(Eterm acc, Uint size)
 	 * bignum buffer with one extra word to be used if
 	 * the bignum grows in the future.
 	 */
-	Eterm* hp = (Eterm *) erts_alloc(ERTS_ALC_T_TEMP_TERM,
+	Eterm* hp = (Eterm *) erts_alloc(ERTS_ALC_T_SHORT_LIVED_TERM,
 					 (BIG_UINT_HEAP_SIZE+1) *
 					 sizeof(Eterm));
 	return uint_to_big(size, hp);
@@ -2385,7 +2385,7 @@ accumulate(Eterm acc, Uint size)
 	     * The extra word has been consumed. Grow the
 	     * allocation by one word.
 	     */
-	    big = (Eterm *) erts_realloc(ERTS_ALC_T_TEMP_TERM,
+	    big = (Eterm *) erts_realloc(ERTS_ALC_T_SHORT_LIVED_TERM,
 					 big_val(acc),
 					 (need_heap+1) * sizeof(Eterm));
 	    acc = make_big(big);
@@ -2414,29 +2414,85 @@ consolidate(Process* p, Eterm acc, Uint size)
 	while (sz--) {
 	    *hp++ = *big++;
 	}
-	erts_free(ERTS_ALC_T_TEMP_TERM, (void *) big_val(acc));
+	erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
 	return res;
     }
 }
 
+typedef struct {
+    Eterm obj;
+    Uint size;
+    Eterm acc;
+    Eterm input_list;
+    ErtsEStack stack;
+    int is_trap_at_L_iter_list;
+} ErtsIOListSizeContext;
+
+static int iolist_size_ctx_bin_dtor(Binary *context_bin) {
+    ErtsIOListSizeContext* context = ERTS_MAGIC_BIN_DATA(context_bin);
+    DESTROY_SAVED_ESTACK(&context->stack);
+    if (context->acc != THE_NON_VALUE) {
+        erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(context->acc));
+    }
+    return 1;
+}
+
 BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
 {
-    Eterm obj, hd;
+    static const Uint ITERATIONS_PER_RED = 64;
+    Eterm input_list, obj, hd;
     Eterm* objp;
     Uint size = 0;
     Uint cur_size;
     Uint new_size;
     Eterm acc = THE_NON_VALUE;
     DECLARE_ESTACK(s);
-
-    obj = BIF_ARG_1;
+    Uint max_iterations;
+    Uint iterations_until_trap = max_iterations =
+        ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P);
+    ErtsIOListSizeContext* context = NULL;
+    Eterm state_mref;
+    int is_trap_at_L_iter_list;
+    ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+#ifdef DEBUG
+    iterations_until_trap = iterations_until_trap / 10;
+#endif
+    input_list = obj = BIF_ARG_1;
+    if (is_internal_magic_ref(obj)) {
+        /* Restore state after a trap */
+        Binary* state_bin;
+        state_mref = obj;
+        state_bin = erts_magic_ref2bin(state_mref);
+        if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) != iolist_size_ctx_bin_dtor) {
+            BIF_ERROR(BIF_P, BADARG);
+        }
+        context = ERTS_MAGIC_BIN_DATA(state_bin);
+        obj = context->obj;
+        size = context->size;
+        acc = context->acc;
+        input_list = context->input_list;
+        ESTACK_RESTORE(s, &context->stack);
+        ASSERT(BIF_P->flags & F_DISABLE_GC);
+        erts_set_gc_state(BIF_P, 1);
+        if (context->is_trap_at_L_iter_list) {
+            goto L_iter_list;
+        }
+    }
     goto L_again;
 
     while (!ESTACK_ISEMPTY(s)) {
 	obj = ESTACK_POP(s);
+        if (iterations_until_trap == 0) {
+            is_trap_at_L_iter_list = 0;
+            goto L_save_state_and_trap;
+        }
     L_again:
 	if (is_list(obj)) {
 	L_iter_list:
+            if (iterations_until_trap == 0) {
+                is_trap_at_L_iter_list = 1;
+                goto L_save_state_and_trap;
+            }
 	    objp = list_val(obj);
 	    hd = CAR(objp);
 	    obj = CDR(objp);
@@ -2458,12 +2514,14 @@ BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
 	    } else if (is_list(hd)) {
 		ESTACK_PUSH(s, obj);
 		obj = hd;
+                iterations_until_trap--;
 		goto L_iter_list;
 	    } else if (is_not_nil(hd)) {
 		goto L_type_error;
 	    }
 	    /* Tail */
 	    if (is_list(obj)) {
+                iterations_until_trap--;
 		goto L_iter_list;
 	    } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
 		cur_size = binary_size(obj);
@@ -2487,14 +2545,55 @@ BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
 	} else if (is_not_nil(obj)) {
 	    goto L_type_error;
 	}
+        iterations_until_trap--;
     }
 
     DESTROY_ESTACK(s);
+    BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
+    ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+    if (context != NULL) {
+        /* context->acc needs to be reset so that
+           iolist_size_ctx_bin_dtor does not deallocate twice */
+        context->acc = THE_NON_VALUE;
+    }
     BIF_RET(consolidate(BIF_P, acc, size));
 
  L_type_error:
     DESTROY_ESTACK(s);
-    BIF_ERROR(BIF_P, BADARG);
+    if (acc != THE_NON_VALUE) {
+	erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
+        if (context != NULL) {
+            context->acc = THE_NON_VALUE;
+        }
+    }
+    BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
+    ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+    if (context == NULL) {
+        BIF_ERROR(BIF_P, BADARG);
+    } else {
+        ERTS_BIF_ERROR_TRAPPED1(BIF_P,
+                                BADARG,
+                                bif_export[BIF_iolist_size_1],
+                                input_list);
+    }
+
+ L_save_state_and_trap:
+    if (context == NULL) {
+        Binary *state_bin = erts_create_magic_binary(sizeof(ErtsIOListSizeContext),
+                                                     iolist_size_ctx_bin_dtor);
+        Eterm* hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+        state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin);
+        context = ERTS_MAGIC_BIN_DATA(state_bin);
+    }
+    context->obj = obj;
+    context->size = size;
+    context->acc = acc;
+    context->is_trap_at_L_iter_list = is_trap_at_L_iter_list;
+    context->input_list = input_list;
+    ESTACK_SAVE(s, &context->stack);
+    erts_set_gc_state(BIF_P, 0);
+    BUMP_ALL_REDS(BIF_P);
+    BIF_TRAP1(bif_export[BIF_iolist_size_1], BIF_P, state_mref);
 }
 
 /**********************************************************************/
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 08dcc5ea9a..37ec62ab37 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -345,16 +345,17 @@ type	COUNTERS	STANDARD	SYSTEM		erl_bif_counters
 # Types used by system specific code
 #
 
-type  	TEMP_TERM 	TEMPORARY	SYSTEM		temp_term
-type	DRV_TAB		LONG_LIVED	SYSTEM		drv_tab
-type	DRV_EV_STATE	LONG_LIVED	SYSTEM		driver_event_state
-type	DRV_SEL_D_STATE	FIXED_SIZE	SYSTEM		driver_select_data_state
-type	NIF_SEL_D_STATE	FIXED_SIZE	SYSTEM		enif_select_data_state
-type	POLLSET		LONG_LIVED	SYSTEM		pollset
-type	POLLSET_UPDREQ	SHORT_LIVED	SYSTEM		pollset_update_req
-type	POLL_FDS	LONG_LIVED	SYSTEM		poll_fds
-type	FD_STATUS	LONG_LIVED	SYSTEM		fd_status
-type	SELECT_FDS	LONG_LIVED	SYSTEM		select_fds
+type  	TEMP_TERM       	TEMPORARY	SYSTEM		temp_term
+type  	SHORT_LIVED_TERM 	SHORT_LIVED	SYSTEM		short_lived_term
+type	DRV_TAB		        LONG_LIVED	SYSTEM		drv_tab
+type	DRV_EV_STATE	        LONG_LIVED	SYSTEM		driver_event_state
+type	DRV_SEL_D_STATE	        FIXED_SIZE	SYSTEM		driver_select_data_state
+type	NIF_SEL_D_STATE	        FIXED_SIZE	SYSTEM		enif_select_data_state
+type	POLLSET		        LONG_LIVED	SYSTEM		pollset
+type	POLLSET_UPDREQ	        SHORT_LIVED	SYSTEM		pollset_update_req
+type	POLL_FDS	        LONG_LIVED	SYSTEM		poll_fds
+type	FD_STATUS	        LONG_LIVED	SYSTEM		fd_status
+type	SELECT_FDS	        LONG_LIVED	SYSTEM		select_fds
 
 +if unix
 
diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab
index 609869ad9f..656acfebdb 100644
--- a/erts/emulator/beam/erl_dirty_bif.tab
+++ b/erts/emulator/beam/erl_dirty_bif.tab
@@ -57,7 +57,6 @@ dirty-cpu erts_debug:lcnt_clear/0
 #  and debug purposes only. We really do *not* want to execute these
 #  on dirty schedulers on a real system.
 
-dirty-cpu-test erlang:iolist_size/1
 dirty-cpu-test erlang:make_tuple/2
 dirty-cpu-test erlang:make_tuple/3
 dirty-cpu-test erlang:append_element/2
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 23c675733c..1406ddc9dc 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -40,6 +40,7 @@
 %%
 
 -include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
 
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2, 
@@ -50,6 +51,14 @@
 	 terms/1, terms_float/1, float_middle_endian/1,
          b2t_used_big/1,
 	 external_size/1, t_iolist_size/1,
+         t_iolist_size_huge_list/1,
+         t_iolist_size_huge_bad_arg_list/1,
+         t_iolist_size_shallow_trapping/1,
+         t_iolist_size_shallow_short_lists/1,
+         t_iolist_size_shallow_tiny_lists/1,
+         t_iolist_size_deep_trapping/1,
+         t_iolist_size_deep_short_lists/1,
+         t_iolist_size_deep_tiny_lists/1,
 	 t_hash/1,
 	 bad_size/1,
 	 bad_term_to_binary/1,
@@ -75,6 +84,9 @@ all() ->
      t_split_binary, bad_split,
      bad_list_to_binary, bad_binary_to_list, terms,
      terms_float, float_middle_endian, external_size, t_iolist_size,
+     t_iolist_size_huge_list,
+     t_iolist_size_huge_bad_arg_list,
+     {group, iolist_size_benchmarks},
      b2t_used_big,
      bad_binary_to_term_2, safe_binary_to_term2,
      bad_binary_to_term, bad_terms, t_hash, bad_size,
@@ -86,13 +98,36 @@ all() ->
      error_after_yield, cmp_old_impl].
 
 groups() -> 
-    [].
+    [
+     {
+      iolist_size_benchmarks, 
+      [],
+      [t_iolist_size_shallow_trapping,
+       t_iolist_size_shallow_short_lists,
+       t_iolist_size_shallow_tiny_lists,
+       t_iolist_size_deep_trapping,
+       t_iolist_size_deep_short_lists,
+       t_iolist_size_deep_tiny_lists
+      ]
+     }
+    ].
 
 init_per_suite(Config) ->
+    A0 = case application:start(sasl) of
+	     ok -> [sasl];
+	     _ -> []
+	 end,
+    A = case application:start(os_mon) of
+	     ok -> [os_mon|A0];
+	     _ -> A0
+	 end,
+    [{started_apps, A}|Config].
+
+end_per_suite(Config) ->
+    As = proplists:get_value(started_apps, Config),
+    lists:foreach(fun (A) -> application:stop(A) end, As),
     Config.
 
-end_per_suite(_Config) ->
-    ok.
 
 init_per_group(_GroupName, Config) ->
     Config.
@@ -615,6 +650,143 @@ build_iolist(N0, Base) ->
 	    [47,L,L|Seq]
     end.
 
+approx_4GB_bin() ->
+    Bin = lists:duplicate(4194304, 255),
+    BinRet = erlang:iolist_to_binary(lists:duplicate(1124, Bin)),
+    BinRet.
+
+duplicate_iolist(IOList, 0) ->
+    IOList;
+duplicate_iolist(IOList, NrOfTimes) ->
+    duplicate_iolist([IOList, IOList], NrOfTimes - 1).
+
+t_iolist_size_huge_list(Config)  when is_list(Config) ->
+    run_when_enough_resources(
+      fun() ->
+              {TimeToCreateIOList, IOList} = timer:tc(fun()->duplicate_iolist(approx_4GB_bin(), 32) end),
+              {IOListSizeTime, CalculatedSize} = timer:tc(fun()->erlang:iolist_size(IOList) end),
+              20248183924657750016 = CalculatedSize,
+              {comment, io_lib:format("Time to create iolist: ~f s. Time to calculate size: ~f s.", 
+                                      [TimeToCreateIOList / 1000000, IOListSizeTime / 1000000])}
+      end).
+
+t_iolist_size_huge_bad_arg_list(Config)  when is_list(Config) ->
+    run_when_enough_resources(
+      fun() ->
+              P = self(),
+              spawn_link(fun()-> IOListTmp = duplicate_iolist(approx_4GB_bin(), 32),
+                                 IOList = [IOListTmp, [badarg]],
+                                 {'EXIT',{badarg,_}} = (catch erlang:iolist_size(IOList)),
+                                 P ! ok
+                         end),
+              receive ok -> ok end
+         end).
+
+%% iolist_size tests for shallow lists
+
+t_iolist_size_shallow_trapping(Config) when is_list(Config) ->
+    Lengths = [2000, 20000, 200000, 200000, 2000000, 20000000],
+    run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+t_iolist_size_shallow_short_lists(Config) when is_list(Config) ->
+    Lengths = lists:duplicate(15000, 300),
+    run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+t_iolist_size_shallow_tiny_lists(Config) when is_list(Config) ->
+    Lengths = lists:duplicate(250000, 18),
+    run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+make_shallow_iolist(SizeDiv2, LastItem) ->
+    lists:map(
+      fun(I) -> 
+              case I of
+                  SizeDiv2 -> [1, LastItem];
+                  _ -> [1, 1]
+              end
+      end,
+      lists:seq(1, SizeDiv2)).
+
+%% iolist_size tests for deep lists
+
+t_iolist_size_deep_trapping(Config) when is_list(Config) ->
+    Lengths = [2000, 20000, 200000, 200000, 2000000, 10000000],
+    run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+t_iolist_size_deep_short_lists(Config) when is_list(Config) ->
+    Lengths = lists:duplicate(10000, 300),
+    run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+t_iolist_size_deep_tiny_lists(Config) when is_list(Config) ->
+    Lengths = lists:duplicate(150000, 18),
+    run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+make_deep_iolist(1, LastItem) ->
+    [1, LastItem];
+make_deep_iolist(Depth, LastItem) ->
+    [[1, 1], make_deep_iolist(Depth - 1, LastItem)].
+
+% Helper functions for iolist_size tests
+
+run_iolist_size_test_and_benchmark(Lengths, ListGenerator) ->
+    run_when_enough_resources(
+      fun() ->
+              GoodListsWithSizes =
+                  lists:map(fun(Length) -> {Length*2, ListGenerator(Length, 1)} end, Lengths),
+              BadListsWithSizes =
+                  lists:map(fun(Length) -> {Length*2, ListGenerator(Length, bad)} end, Lengths),
+              erlang:garbage_collect(),
+              report_throughput(
+                fun() ->
+                        lists:foreach(
+                          fun(_)->
+                                  lists:foreach(
+                                    fun({Size, List}) -> Size = iolist_size(List) end,
+                                    GoodListsWithSizes),
+                                  lists:foreach(
+                                    fun({_, List}) -> {'EXIT',_} = (catch (iolist_size(List))) end,
+                                    BadListsWithSizes)
+                          end,
+                          lists:seq(1,3))
+                end,
+                lists:sum(Lengths)*4)
+      end).
+
+report_throughput(Fun, NrOfItems) ->
+    Parent = self(),
+    spawn(fun() -> Parent ! timer:tc(Fun) end),
+    {Time, _} = receive D -> D end,
+    ItemsPerMicrosecond = NrOfItems / Time,
+    ct_event:notify(#event{ name = benchmark_data, data = [{value, ItemsPerMicrosecond}]}),
+    {comment, io_lib:format("Items per microsecond: ~p, Nr of items: ~p, Benchmark time: ~p seconds)",
+                            [ItemsPerMicrosecond, NrOfItems, Time/1000000])}.
+
+total_memory() ->
+    %% Total memory in GB.
+    try
+	MemoryData = memsup:get_system_memory_data(),
+	case lists:keysearch(total_memory, 1, MemoryData) of
+	    {value, {total_memory, TM}} ->
+		TM div (1024*1024*1024);
+	    false ->
+		{value, {system_total_memory, STM}} =
+		    lists:keysearch(system_total_memory, 1, MemoryData),
+		STM div (1024*1024*1024)
+	end
+    catch
+	_ : _ ->
+	    undefined
+    end.
+
+run_when_enough_resources(Fun) ->
+    case {total_memory(), erlang:system_info(wordsize)} of
+        {Mem, 8} when is_integer(Mem) andalso Mem >= 15 ->
+            Fun();
+        {Mem, WordSize} ->
+            {skipped, 
+             io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)",
+                           [Mem, WordSize])}
+    end.
+    
 
 %% OTP-4053
 bad_binary_to_term_2(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/emulator_bench.spec b/erts/emulator/test/emulator_bench.spec
index f709d913b7..2a180b440c 100644
--- a/erts/emulator/test/emulator_bench.spec
+++ b/erts/emulator/test/emulator_bench.spec
@@ -1 +1,2 @@
 {groups,"../emulator_test",estone_SUITE,[estone_bench]}.
+{groups,"../emulator_test",binary_SUITE,[iolist_size_benchmarks]}.