Merge branch 'pg/fix-hibernate-with-hipe' into dev

* pg/fix-hibernate-with-hipe:
  Update copyright years
  Fix NULL-free bug in hibernate on debug emulator
  Fix several bugs related to hibernate/3 and HiPE

Conflicts:
	erts/emulator/test/hibernate_SUITE.erl

OTP-9125

9 files changed, 120 insertions, 26 deletions

diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index e96014c665..7b2aac0908 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1023,8 +1023,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,
@@ -3421,6 +3419,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);
@@ -5222,7 +5223,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);
@@ -6199,8 +6200,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..f01580eb2b 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1,7 +1,7 @@
 /*
  * %CopyrightBegin%
  *
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
  *
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
@@ -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..8faa09feb8 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -1,7 +1,7 @@
 /*
  * %CopyrightBegin%
  *
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
  *
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
@@ -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..d9150d86fe 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1,7 +1,7 @@
 /*
  * %CopyrightBegin%
  *
- * Copyright Ericsson AB 2002-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2011. All Rights Reserved.
  *
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
@@ -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 bd540eaaa6..40cb634e11 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1700,6 +1700,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..53ebcd4008 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -1,7 +1,7 @@
 /*
  * %CopyrightBegin%
  * 
- * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2011. All Rights Reserved.
  * 
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
@@ -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,17 @@ void hipe_inc_nstack(Process *p)
 }
 #endif
 
+void hipe_empty_nstack(Process *p)
+{
+    if (p->hipe.nstack) {
+	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..e0c6c1b5f5 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -1,7 +1,7 @@
 /*
  * %CopyrightBegin%
  * 
- * Copyright Ericsson AB 2001-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2011. All Rights Reserved.
  * 
  * The contents of this file are subject to the Erlang Public License,
  * Version 1.1, (the "License"); you may not use this file except in
@@ -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..3afcae494d 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -1,7 +1,7 @@
 #
 # %CopyrightBegin%
 #
-# Copyright Ericsson AB 1997-2010. All Rights Reserved.
+# Copyright Ericsson AB 1997-2011. All Rights Reserved.
 #
 # The contents of this file are subject to the Erlang Public License,
 # Version 1.1, (the "License"); you may not use this file except in
@@ -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 b8dc87db7f..203fa6b48e 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
 %% 
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
@@ -24,16 +24,16 @@
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2,
 	 init_per_testcase/2,end_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]).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
-    [basic, min_heap_size, bad_args, messages_in_queue,
+    [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue,
      undefined_mfa, no_heap].
 
 groups() -> 
@@ -159,10 +159,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]),