hipe,erts: Debug support for native call trace

8 files changed, 50 insertions, 5 deletions

diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c
index ee97541e15..4d42efc1cc 100644
--- a/erts/emulator/hipe/hipe_bif2.c
+++ b/erts/emulator/hipe/hipe_bif2.c
@@ -189,3 +189,10 @@ BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1)
 
 #endif /* ERTS_ENABLE_LOCK_CHECK && ERTS_SMP */
 
+
+BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2)
+{
+    erts_printf("hipe_debug_native_called: %T(%T)\r\n", BIF_ARG_1, BIF_ARG_2);
+    BIF_RET(am_ok);
+}
+
diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab
index 51323ce7af..d43ee40c5d 100644
--- a/erts/emulator/hipe/hipe_bif2.tab
+++ b/erts/emulator/hipe/hipe_bif2.tab
@@ -30,3 +30,4 @@ bif hipe_bifs:in_native/0
 bif hipe_bifs:modeswitch_debug_on/0
 bif hipe_bifs:modeswitch_debug_off/0
 bif hipe_bifs:show_message_area/0
+bif hipe_bifs:debug_native_called/2
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 942fa0c5cb..d9aa09b79e 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -165,6 +165,7 @@ gc_bif_interface_2(nbif_put_2, put_2)
 gc_bif_interface_1(nbif_hipe_bifs_show_nstack_1, hipe_show_nstack_1)
 gc_bif_interface_1(nbif_hipe_bifs_show_pcb_1, hipe_bifs_show_pcb_1)
 gc_bif_interface_0(nbif_hipe_bifs_nstack_used_size_0, hipe_bifs_nstack_used_size_0)
+gc_bif_interface_2(nbif_hipe_bifs_debug_native_called, hipe_bifs_debug_native_called_2)
 
 /*
  * Arithmetic operators called indirectly by the HiPE compiler.
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 9e3a156fbc..3f460a5a5c 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -110,6 +110,9 @@ int hipe_bs_put_big_integer(Eterm, Uint, byte*, unsigned, unsigned);
 AEXTERN(Eterm,nbif_check_get_msg,(Process*));
 Eterm hipe_check_get_msg(Process*);
 
+AEXTERN(BIF_RETTYPE,nbif_hipe_bifs_debug_native_called,(Process*,Eterm,Eterm));
+BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2);
+
 /*
  * SMP-specific stuff
  */
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index 38509c105b..52b4681cfe 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -80,6 +80,7 @@ PRIMOP_LIST(am_fclearerror_error, &nbif_fclearerror_error)
 #ifdef NO_FPE_SIGNALS
 PRIMOP_LIST(am_emulate_fpe, &nbif_emulate_fpe)
 #endif
+PRIMOP_LIST(am_debug_native_called, &nbif_hipe_bifs_debug_native_called)
 
 #if defined(__sparc__)
 #include "hipe_sparc_primops.h"
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 2d2b414a70..35a8ce9cfe 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -41,6 +41,9 @@
 %%
 %%-ifndef(DEBUG).
 %%-define(DEBUG,6).
+%% Choose one of two tracing methods
+%%-define(DEBUG_BIF_CALL_TRACE,true).
+%%-define(IO_FORMAT_CALL_TRACE,true).
 %%-endif.
 
 -include("../main/hipe.hrl").
@@ -51,8 +54,27 @@
 -define(no_debug_msg(Str,Xs),ok).
 %%-define(no_debug_msg(Str,Xs),msg(Str,Xs)).
 
--define(mk_debugcode(MFA, Env, Code),
-	case MFA of
+-ifdef(DEBUG_BIF_CALL_TRACE).
+
+%% Use BIF hipe_bifs_debug_native_called_2 to trace function calls
+mk_debug_calltrace({_M,_F,A}=MFA, Env, Code) ->
+    MFAVar = mk_var(new),
+    Ignore = mk_var(new),    
+    MkMfa = hipe_icode:mk_move(MFAVar,hipe_icode:mk_const(MFA)),
+    Args = [mk_var({x,I-1}) || I <- lists:seq(1,A)],
+    ArgTup = mk_var(new),
+    MkArgTup = hipe_icode:mk_primop([ArgTup], mktuple, Args),
+    Call = hipe_icode:mk_primop([Ignore], debug_native_called,
+				[MFAVar,ArgTup]),
+    {[MkMfa,MkArgTup,Call | Code], Env}.
+
+-endif.
+
+-ifdef(IO_FORMAT_CALL_TRACE).
+
+%% Use io:format to trace function calls
+mk_debug_calltrace(MFA, Env, Code) ->
+    case MFA of
 	  {io,_,_} ->
 	    %% We do not want to loop infinitely if we are compiling
 	    %% the module io.
@@ -69,7 +91,9 @@
 	    Call =
 	      hipe_icode:mk_call([Ignore],io,format,[StringVar,MFAVar],remote),
 	    {[MkMfa,MkString,Call | Code], Env}
-	end).
+    end.
+-endif.
+
 
 %%-----------------------------------------------------------------------
 %% Exported types
@@ -127,7 +151,7 @@ trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo) ->
   MFA = {M,F,A},
   %% Debug code
   ?IF_DEBUG_LEVEL(5,
-		  {Code3,_Env3} = ?mk_debugcode(MFA, Env2, Code2),
+		  {Code3,_Env3} = mk_debug_calltrace(MFA, Env1, Code2),
 		  {Code3,_Env3} = {Code2,Env1}),
   %% For stack optimization
   Leafness = leafness(Code3),
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index a413531c07..b0113fc556 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -137,7 +137,8 @@ is_safe({hipe_bs_primop, {bs_private_append, _, _}}) -> false;
 is_safe({hipe_bs_primop, bs_init_writable}) -> true;
 is_safe(#mkfun{}) -> true;
 is_safe(#unsafe_element{}) -> true;
-is_safe(#unsafe_update_element{}) -> true.
+is_safe(#unsafe_update_element{}) -> true;
+is_safe(debug_native_called) -> false.
 
 
 -spec fails(icode_funcall()) -> boolean().
@@ -237,6 +238,7 @@ fails({hipe_bs_primop, bs_init_writable}) -> true;
 fails(#mkfun{}) -> false;
 fails(#unsafe_element{}) -> false;
 fails(#unsafe_update_element{}) -> false;
+fails(debug_native_called) -> false;
 %% Apparently, we are calling fails/1 for all MFAs which are compiled.
 %% This is weird and we should restructure the compiler to avoid
 %% calling fails/1 for things that are not primops.
@@ -721,6 +723,8 @@ type(Primop, Args) ->
       erl_types:t_any();
     redtest ->
       erl_types:t_any();
+    debug_native_called ->
+      erl_types:t_any();
     {M, F, A} ->
       erl_bif_types:type(M, F, A, Args)
   end.
@@ -893,6 +897,8 @@ type(Primop) ->
       erl_types:t_any();
     redtest ->
       erl_types:t_any();
+    debug_native_called ->
+      erl_types:t_any();
     {M, F, A} ->
       erl_bif_types:type(M, F, A)
   end.
diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl
index 5f273d8251..53aaa72aa6 100644
--- a/lib/hipe/rtl/hipe_rtl_primops.erl
+++ b/lib/hipe/rtl/hipe_rtl_primops.erl
@@ -396,6 +396,8 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
 	      [Dst1]->
 		hipe_tagscheme:unsafe_tag_float(Dst1, Arg)
 	    end;
+	  debug_native_called -> 
+	    [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
 
 	  %% Only names listed above are accepted! MFA:s are not primops!
 	  _ ->