From a17eaa7e2cc2f68fbc9bf5c924c5a230d650b9f1 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson <sverker@erlang.org>
Date: Thu, 1 Dec 2011 20:13:57 +0100
Subject: hipe,erts: Debug support for native call trace

---
 lib/hipe/icode/hipe_beam_to_icode.erl | 32 ++++++++++++++++++++++++++++----
 lib/hipe/icode/hipe_icode_primops.erl |  8 +++++++-
 lib/hipe/rtl/hipe_rtl_primops.erl     |  2 ++
 3 files changed, 37 insertions(+), 5 deletions(-)

(limited to 'lib/hipe')

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!
 	  _ ->
-- 
cgit v1.2.3