Replace erlang:binary_to_term() Erlang wrappers

Replace the 'erlang:binary_to_term/1' and 'erlang:binary_to_term/2'
Erlang wrappers taking care of failure after yield with management
of this in the hidden yield BIF.

4 files changed, 75 insertions, 33 deletions

diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 2d888862bf..9816883c9a 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -45,6 +45,7 @@ bif erlang:apply/3
 bif erlang:atom_to_list/1
 bif erlang:binary_to_list/1
 bif erlang:binary_to_list/3
+bif erlang:binary_to_term/1
 bif erlang:crc32/1
 bif erlang:crc32/2
 bif erlang:crc32_combine/3
@@ -151,8 +152,6 @@ bif erts_internal:port_command/3
 bif erts_internal:port_control/3
 bif erts_internal:port_close/1
 bif erts_internal:port_connect/2
-bif erts_internal:binary_to_term/1
-bif erts_internal:binary_to_term/2
 
 bif erts_internal:request_system_task/3
 bif erts_internal:check_process_code/2
@@ -480,6 +479,11 @@ bif erlang:call_on_load_function/1
 bif erlang:finish_after_on_load/2
 
 #
+# New Bifs in R13B04
+#
+bif erlang:binary_to_term/2
+
+#
 # The binary match bifs (New in R14A - EEP9)
 #
 
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index e376253400..8d240355b0 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -108,26 +108,17 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm
 
 static Export binary_to_term_trap_export;
 static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1);
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b);
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+				      Export *bif, Eterm arg0, Eterm arg1);
 
 void erts_init_external(void) {
-#if 1 /* In R16 */
     erts_init_trap_export(&term_to_binary_trap_export,
-			  am_erlang, am_term_to_binary_trap, 1,
+			  am_erts_internal, am_term_to_binary_trap, 1,
 			  &term_to_binary_trap_1);
 
     erts_init_trap_export(&binary_to_term_trap_export,
-			  am_erlang, am_binary_to_term_trap, 1,
+			  am_erts_internal, am_binary_to_term_trap, 1,
 			  &binary_to_term_trap_1);
-#else
-    sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export));
-    term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3];
-    term_to_binary_trap_export.code[0] = am_erlang;
-    term_to_binary_trap_export.code[1] = am_term_to_binary_trap;
-    term_to_binary_trap_export.code[2] = 1;
-    term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif;
-    term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1;
-#endif    
     return;
 }
 
@@ -1186,6 +1177,8 @@ typedef struct B2TContext_t {
     Uint32 flags;
     SWord reds;
     Eterm trap_bin;
+    Export *bif;
+    Eterm arg[2];
     enum B2TState state;
     union {
 	B2TSizeContext sc;
@@ -1357,7 +1350,8 @@ static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1)
     Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val;
     ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor);
 
-    return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin);
+    return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL,
+			      THE_NON_VALUE, THE_NON_VALUE);
 }
 
 
@@ -1392,8 +1386,10 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src)
     return ctx;
 }
 
-static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b)
+static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
+				      Export *bif_init, Eterm arg0, Eterm arg1)
 {
+    BIF_RETTYPE ret_val;
 #ifdef EXTREME_B2T_TRAPPING
     SWord initial_reds = 1 + b2t_rand() % 4;
 #else
@@ -1410,6 +1406,9 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
 	ctx->state = B2TPrepare;
         ctx->aligned_alloc = NULL;
         ctx->flags = flags;
+	ctx->bif = bif_init;
+	ctx->arg[0] = arg0;
+	ctx->arg[1] = arg1;
         IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;)
     } else {
         is_first_call = 0;
@@ -1505,12 +1504,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
             HRelease(p, ctx->u.dc.hp_end, ctx->u.dc.hp_start);
             /*fall through*/
         case B2TBadArg:
-            b2t_destroy_context(ctx);
-            if (!is_first_call) {
-                erts_set_gc_state(p, 1);
-            }
             BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
-            BIF_ERROR(p, BADARG & ~EXF_SAVETRACE);
+
+	    ASSERT(ctx->bif == bif_export[BIF_binary_to_term_1]
+		   || ctx->bif == bif_export[BIF_binary_to_term_2]);
+
+	    if (is_first_call)
+		ERTS_BIF_PREP_ERROR(ret_val, p, BADARG);
+	    else {
+                erts_set_gc_state(p, 1);
+		if (is_non_value(ctx->arg[1]))
+		    ERTS_BIF_PREP_ERROR_TRAPPED1(ret_val, p, BADARG, ctx->bif,
+						 ctx->arg[0]);
+		else
+		    ERTS_BIF_PREP_ERROR_TRAPPED2(ret_val, p, BADARG, ctx->bif,
+						 ctx->arg[0], ctx->arg[1]);
+	    }
+            b2t_destroy_context(ctx);
+	    return ret_val;
 
         case B2TDone:
             b2t_destroy_context(ctx);
@@ -1525,7 +1536,8 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
                 erts_set_gc_state(p, 1);
             }
             BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION);
-            return ctx->u.dc.res;
+	    ERTS_BIF_PREP_RET(ret_val, ctx->u.dc.res);
+	    return ret_val;
 
         default:
             ASSERT(!"Unknown state in binary_to_term");
@@ -1542,19 +1554,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con
         erts_set_gc_state(p, 0);
     }
     BUMP_ALL_REDS(p);
-    BIF_TRAP1(&binary_to_term_trap_export, p, ctx->trap_bin);
+
+    ERTS_BIF_PREP_TRAP1(ret_val, &binary_to_term_trap_export,
+			p, ctx->trap_bin);
+
+    return ret_val;
 }
 
-HIPE_WRAPPER_BIF_DISABLE_GC(erts_internal_binary_to_term, 1)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1)
 
-BIF_RETTYPE erts_internal_binary_to_term_1(BIF_ALIST_1)
+BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
 {
-    return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL);
+    return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1],
+			      BIF_ARG_1, THE_NON_VALUE);
 }
 
-HIPE_WRAPPER_BIF_DISABLE_GC(erts_internal_binary_to_term, 2)
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2)
 
-BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
+BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
 {
     Eterm opts;
     Eterm opt;
@@ -1575,7 +1592,8 @@ BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2)
     if (is_not_nil(opts))
         goto error;
 
-    return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL);
+    return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2],
+			      BIF_ARG_1, BIF_ARG_2);
 
 error:
     BIF_ERROR(BIF_P, BADARG);
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 16765fdb99..5f92b6bac4 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -268,8 +268,8 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc)
  */
 define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1,
 ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2,
-ifelse($1,erts_internal_binary_to_term_1,hipe_wrapper_erts_internal_binary_to_term_1,
-ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_term_2,
+ifelse($1,binary_to_term_1,hipe_wrapper_binary_to_term_1,
+ifelse($1,binary_to_term_2,hipe_wrapper_binary_to_term_2,
 ifelse($1,binary_to_list_1,hipe_wrapper_binary_to_list_1,
 ifelse($1,binary_to_list_3,hipe_wrapper_binary_to_list_3,
 ifelse($1,bitstring_to_list_1,hipe_wrapper_bitstring_to_list_1,
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 22c4ed29ad..44e9e4f243 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1420,6 +1420,11 @@ error_after_yield(Config) when is_list(Config) ->
     error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap),
     error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
 
+    B2TTrap = {erts_internal, binary_to_term_trap, 1},
+
+    error_after_yield(badarg, erlang, binary_to_term, 1, fun () -> [error_after_yield_bad_ext_term()] end, B2TTrap),
+    error_after_yield(badarg, erlang, binary_to_term, 2, fun () -> [error_after_yield_bad_ext_term(), [safe]] end, B2TTrap),
+
     case erlang:system_info(wordsize) of
 	4 ->
 	    SysLimitSz = 1 bsl 32,
@@ -1462,7 +1467,7 @@ error_after_yield(Type, M, F, AN, AFun, TrapFunc) ->
 	{trace_delivered, Pid, TD} ->
 	    NoYields = error_after_yield_sched(Pid, TrapFunc, 0),
 	    io:format("No of yields: ~p~n", [NoYields]),
-	    true =  NoYields > 10
+	    true =  NoYields > 2
     end,
     ok.
 
@@ -1485,6 +1490,21 @@ error_after_yield_sched(P, TrapFunc, N) ->
     after 0 ->
 	    N
     end.
+
+error_after_yield_bad_ext_term() ->
+    TupleSz = 2000000,
+    <<131, % Version magic
+      AtomExt/binary>> = term_to_binary(an_atom_we_use_for_this),
+    BadAtomExt = [100, %% ATOM_EXT
+		  255, 255, % Invalid size of 65535 bytes
+		  "oops"],
+
+    %% Produce a large tuple where the last element is invalid
+    list_to_binary([131, %% Version magic
+		    105, %% LARGE_TUPLE_EXT
+		    <<TupleSz:32/big>>, %% Tuple size
+		    lists:duplicate(TupleSz-1, AtomExt), %% Valid atoms
+		    BadAtomExt]). %% Invalid atom at the end
 	    
 cmp_old_impl(Config) when is_list(Config) ->
     %% Compare results from new yielding implementations with