Fix several bugs related to hibernate/3 and HiPE

This commit fixes four related bugs:
- calling hibernate/3 using a dynamic call would fail with badarg
as hibernate/3 as a BIF was not implemented. hibernate/3 is generally
provided as a Beam instruction, and code is translated to use this
instruction when loaded.
- calling hibernate/3 from HiPE would fail with badarg because this
would call the aforementioned BIF which was not implemented.
- calling hibernate/3 with some HiPE-native garbage in the process heap
would randomly crash at the next garbage collect. This bug only
happened in a complex, yet reproduceable scenarios, where native code
calls beam code that calls hibernate/3, and the process has some
garbage when being hibernated and the process generates garbage when
awaken.
- when entering HiPE, the process current_function can be set and be
inaccurate.

The fix is three folded:
- hibernate_3 BIF now actually works instead of throwing a badarg. While
hibernate_3 BIF was (usually) not called from BEAM, it is called from
HiPE. hibernate behaviour is very close to the scheduler and this is why
it is implemented as an instruction in BEAM. The fix consists in doing
the actual hibernation (through the now exported erts_hibernate
function) and setting the process flag to TRAP as well as the process
status to P_WAITING. On BIF epilogue in both BEAM and HiPE, this status
is tested on TRAP and if set, the scheduler is invoked. The i_hibernate
instruction and translation code is now redundant and could be deleted.
- hibernation now also empties the HiPE native stack, with a new
function hipe_empty_nstack provided by Mikael Pettersson.
- when entering HiPE through hipe_mode_switch, p->current is cleared,
as suggested by Mikael Pettersson. p->current normally hold a pointer to
the {M,F,A} of the current function if it exists. When hibernating, it
is set to {erlang,hibernate,3}, and all stdlib hibernate tests
(gen_server_SUITE:hibernate/1, proc_lib_suite:hibernate/1, etc.)
actually rely on this information. Clearing p->current fixes the tests
and avoids the surprise one might have when querying the process info
of a process that hibernated and woke up in a native function.

Non-regression tests are provided, a test for the dynamic call as well
as a Makefile-handled duplication of the hibernate_SUITE into
hibernate_native_SUITE for the HiPE case.

9 files changed, 111 insertions, 19 deletions

diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 16741aa2d7..88ac6cffb1 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1017,8 +1017,6 @@ static BeamInstr* call_error_handler(Process* p, BeamInstr* ip,
 static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE;
 static BeamInstr* apply(Process* p, Eterm module, Eterm function,
 			Eterm args, Eterm* reg) NOINLINE;
-static int hibernate(Process* c_p, Eterm module, Eterm function,
-		     Eterm args, Eterm* reg) NOINLINE;
 static BeamInstr* call_fun(Process* p, int arity,
 			   Eterm* reg, Eterm args) NOINLINE;
 static BeamInstr* apply_fun(Process* p, Eterm fun,
@@ -3393,6 +3391,9 @@ void process_main(void)
 		r(0) = c_p->def_arg_reg[0];
 		x(1) = c_p->def_arg_reg[1];
 		x(2) = c_p->def_arg_reg[2];
+		if (c_p->status == P_WAITING) {
+		    goto do_schedule;
+		}
 		Dispatch();
 	    }
 	    reg[0] = r(0);
@@ -5191,7 +5192,7 @@ void process_main(void)
 
  OpCase(i_hibernate): {
      SWAPOUT;
-     if (hibernate(c_p, r(0), x(1), x(2), reg)) {
+     if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) {
 	 goto do_schedule;
      } else {
 	 I = handle_error(c_p, I, reg, hibernate_3);
@@ -6178,8 +6179,8 @@ fixed_apply(Process* p, Eterm* reg, Uint arity)
     return ep->address;
 }
 
-static int
-hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg)
+int
+erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg)
 {
     int arity;
     Eterm tmp;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index bb237e378a..5cf3f523b8 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1091,10 +1091,20 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
 BIF_RETTYPE hibernate_3(BIF_ALIST_3)
 {
     /*
-     * hibernate/3 is implemented as an instruction; therefore
-     * this function will never be called.
+     * hibernate/3 is usually translated to an instruction; therefore
+     * this function is only called from HiPE or when the call could not
+     * be translated.
      */
-    BIF_ERROR(BIF_P, BADARG);
+    Eterm reg[3];
+
+    if (erts_hibernate(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, reg)) {
+        /*
+         * If hibernate succeeded, TRAP. The process will be suspended
+         * if status is P_WAITING or continue (if any message was in the queue).
+         */
+        BIF_TRAP_CODE_PTR_(BIF_P, BIF_P->i);
+    }
+    return THE_NON_VALUE;
 }
 
 /**********************************************************************/
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index a84ee7bb23..615714f7f4 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -201,6 +201,12 @@ do {							\
       return THE_NON_VALUE;				\
  } while(0)
 
+#define BIF_TRAP_CODE_PTR_(p, Code_) do {		\
+      *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_);	\
+      (p)->freason = TRAP;				\
+      return THE_NON_VALUE;				\
+ } while(0)
+
 extern Export bif_return_trap_export;
 #ifdef DEBUG
 #define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL)		\
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 2aa932e7d1..1a405e0c4d 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -33,6 +33,7 @@
 #include "erl_gc.h"
 #if HIPE
 #include "hipe_stack.h"
+#include "hipe_mode_switch.h"
 #endif
 
 #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1
@@ -486,6 +487,9 @@ erts_garbage_collect_hibernate(Process* p)
     htop = heap;
 
     n = setup_rootset(p, p->arg_reg, p->arity, &rootset);
+#if HIPE
+    hipe_empty_nstack(p);
+#endif
 
     src = (char *) p->heap;
     src_size = (char *) p->htop - src;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index e8a9d5f32f..42aafe6ac6 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1664,6 +1664,7 @@ Uint erts_current_reductions(Process* current, Process *p);
 
 int erts_print_system_version(int to, void *arg, Process *c_p);
 
+int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg);
 #define seq_trace_output(token, msg, type, receiver, process) \
 seq_trace_output_generic((token), (msg), (type), (receiver), (process), NIL)
 #define seq_trace_output_exit(token, msg, type, receiver, exitfrom) \
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index e5de244d25..e2417b38c5 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -208,6 +208,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
 #endif
 
     p->i = NULL;
+    /* Set current_function to undefined. stdlib hibernate tests rely on it. */
+    p->current = NULL;
 
     DPRINTF("cmd == %#x (%s)", cmd, code_str(cmd));
     HIPE_CHECK_PCB(p);
@@ -322,20 +324,31 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
 	   * We need to remove the BIF's parameters from the native
 	   * stack: to this end hipe_${ARCH}_glue.S stores the BIF's
 	   * arity in p->hipe.narity.
+	   *
+	   * If the BIF emptied the stack (typically hibernate), p->hipe.nsp is
+	   * NULL and there is no need to get rid of stacked parameters.
 	   */
-	  unsigned int i, is_recursive, callee_arity;
+	  unsigned int i, is_recursive = 0;
 
 	  /* Save p->arity, then update it with the original BIF's arity.
 	     Get rid of any stacked parameters in that call. */
 	  /* XXX: hipe_call_from_native_is_recursive() copies data to
 	     reg[], which is useless in the TRAP case. Maybe write a
 	     specialised hipe_trap_from_native_is_recursive() later. */
-	  callee_arity = p->arity;
-	  p->arity = p->hipe.narity; /* caller's arity */
-	  is_recursive = hipe_call_from_native_is_recursive(p, reg);
-
-	  p->i = (Eterm *)(p->def_arg_reg[3]);
-	  p->arity = callee_arity;
+          if (p->hipe.nsp != NULL) {
+	      unsigned int callee_arity;
+	      callee_arity = p->arity;
+	      p->arity = p->hipe.narity; /* caller's arity */
+	      is_recursive = hipe_call_from_native_is_recursive(p, reg);
+
+	      p->i = (Eterm *)(p->def_arg_reg[3]);
+	      p->arity = callee_arity;
+          }
+
+	  /* If process is in P_WAITING state, we schedule the next process */
+	  if (p->status == P_WAITING) {
+	      goto do_schedule;
+	  }
 
 	  for (i = 0; i < p->arity; ++i)
 	      reg[i] = p->def_arg_reg[i];
@@ -592,6 +605,15 @@ void hipe_inc_nstack(Process *p)
 }
 #endif
 
+void hipe_empty_nstack(Process *p)
+{
+   erts_free(ERTS_ALC_T_HIPE, p->hipe.nstack);
+   p->hipe.nstgraylim = NULL;
+   p->hipe.nsp = NULL;
+   p->hipe.nstack = NULL;
+   p->hipe.nstend = NULL;
+}
+
 static void hipe_check_nstack(Process *p, unsigned nwords)
 {
     while (hipe_nstack_avail(p) < nwords)
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index 187b9145e2..dce238e3bb 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -54,6 +54,7 @@ void hipe_mode_switch_init(void);
 void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure);
 Process *hipe_mode_switch(Process*, unsigned, Eterm*);
 void hipe_inc_nstack(Process *p);
+void hipe_empty_nstack(Process *p);
 void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free);
 Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s);
 
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 7259e1b84d..4b142503a0 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -122,10 +122,14 @@ NO_OPT= bs_bincomp \
 	bs_utf \
 	guard
 
+NATIVE= hibernate
 
 NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
 NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl)
 
+NATIVE_MODULES= $(NATIVE:%=%_native_SUITE)
+NATIVE_ERL_FILES= $(NATIVE_MODULES:%=%.erl)
+
 ERL_FILES= $(MODULES:%=%.erl)
 
 TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
@@ -151,7 +155,7 @@ ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
 # Targets
 # ----------------------------------------------------
 
-make_emakefile: $(NO_OPT_ERL_FILES)
+make_emakefile: $(NO_OPT_ERL_FILES) $(NATIVE_ERL_FILES)
 	# This special rule can be removed when communication with R7B nodes 
 	# is no longer supported.
 	$(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \
@@ -160,6 +164,8 @@ make_emakefile: $(NO_OPT_ERL_FILES)
 	$(MODULES) >> $(EMAKEFILE)
 	$(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \
 	-o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE)
+	$(ERL_TOP)/make/make_emakefile +native $(ERL_COMPILE_FLAGS) \
+	-o$(EBIN) $(NATIVE_MODULES) >> $(EMAKEFILE)
 
 tests debug opt: make_emakefile
 	erl $(ERL_MAKE_FLAGS) -make
@@ -178,6 +184,9 @@ docs:
 %_no_opt_SUITE.erl: %_SUITE.erl
 	sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
 
+%_native_SUITE.erl: %_SUITE.erl
+	sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
+
 # ----------------------------------------------------
 # Release Target
 # ---------------------------------------------------- 
@@ -190,6 +199,7 @@ release_tests_spec: make_emakefile
 	$(INSTALL_DATA) $(EMAKEFILE) $(TEST_SPEC_FILES) \
 		$(ERL_FILES) $(RELSYSDIR)
 	$(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(RELSYSDIR)
+	$(INSTALL_DATA) $(NATIVE_ERL_FILES) $(RELSYSDIR)
 	chmod -f -R u+w $(RELSYSDIR)
 	tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
 
diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl
index 4d36076d12..f3f9ba7724 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -22,14 +22,14 @@
 -include("test_server.hrl").
 
 -export([all/1,init_per_testcase/2,fin_per_testcase/2,
-	 basic/1,min_heap_size/1,bad_args/1,
+	 basic/1,dynamic_call/1,min_heap_size/1,bad_args/1,
 	 messages_in_queue/1,undefined_mfa/1, no_heap/1]).
 
 %% Used by test cases.
--export([basic_hibernator/1,messages_in_queue_restart/2, no_heap_loop/0]).
+-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0]).
 
 all(suite) ->
-    [basic,min_heap_size,bad_args,messages_in_queue,undefined_mfa,no_heap].
+    [basic,dynamic_call,min_heap_size,bad_args,messages_in_queue,undefined_mfa,no_heap].
 
 init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
     Dog = ?t:timetrap(?t:minutes(3)),
@@ -138,10 +138,47 @@ whats_up_calc(A1, A2, A3, A4, A5, A6, A7, A8, A9, Acc) ->
     whats_up_calc(A1-1, A2+1, A3+2, A4+3, A5+4, A6+5, A7+6, A8+7, A9+8, [A1,A2|Acc]).
 
 %%%
+%%% Testing a call to erlang:hibernate/3 that the compiler and loader do not
+%%% translate to an instruction.
+%%%
+
+dynamic_call(Config) when is_list(Config) ->
+    Ref = make_ref(),
+    Info = {self(),Ref},
+    ExpectedHeapSz = case erlang:system_info(heap_type) of
+			 private -> erts_debug:size([Info]);
+			 hybrid -> erts_debug:size([a|b])
+		     end,
+    ?line Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end),
+    ?line hibernate_wake_up(100, ExpectedHeapSz, Child),
+    ?line Child ! please_quit_now,
+    ok.
+
+dynamic_call_hibernator(Info, Function) ->
+    {catchlevel,0} = process_info(self(), catchlevel),
+    receive
+	Any ->
+	    dynamic_call_hibernator_msg(Any, Function, Info),
+	    dynamic_call_hibernator(Info, Function)
+    end.
+
+dynamic_call_hibernator_msg({hibernate,_}, Function, Info) ->
+    catch apply(erlang, Function, [?MODULE, basic_hibernator, [Info]]),
+    exit(hibernate_returned);
+dynamic_call_hibernator_msg(Msg, _Function, Info) ->
+    basic_hibernator_msg(Msg, Info).
+
+%%%
 %%% Testing setting the minimum heap size.
 %%%
 
 min_heap_size(Config) when is_list(Config) ->
+    case test_server:is_native(?MODULE) of
+	true -> {skip, "Test case relies on trace which is not available in HiPE"};
+	false -> min_heap_size_1(Config)
+    end.
+
+min_heap_size_1(Config) when is_list(Config) ->
     ?line erlang:trace(new, true, [call]),
     MFA = {?MODULE,min_hibernator,1},
     ?line 1 = erlang:trace_pattern(MFA, true, [local]),