HiPE: Verify GC safety of derived values

HiPE has had metadata for gc safety on it's temporaries for a while, but
it has never been enforced or even checked, so naturally several
gc-safety violations has slipped through.

A new pass, hipe_rtl_verify_gcsafe verifies gcsafety on optimised RTL
and is used when running the testsuite, and can be manually enabled with
+{hipe,[verify_gcsafe]}.

5 files changed, 48 insertions, 16 deletions

diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 167f5c67bb..cb4c1cfbd3 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -794,7 +794,7 @@ trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}|
   SizeArg = trans_arg(Size),
   BinArg = trans_arg(Binary),
   IcodeDst = mk_var(Dst),
-  Offset = mk_var(reg),
+  Offset = mk_var(reg_gcsafe),
   Base = mk_var(reg),
   trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg],
 		[IcodeDst,Base,Offset],
@@ -805,7 +805,7 @@ trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}|
   SizeArg = trans_arg(Size),
   BinArg = trans_arg(Binary),
   IcodeDst = mk_var(Dst),
-  Offset = mk_var(reg),
+  Offset = mk_var(reg_gcsafe),
   Base = mk_var(reg),
   trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}},
 		 Lbl,[SizeArg,BinArg],
@@ -844,7 +844,7 @@ trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
 	   Instructions], Env) ->
   Dst = mk_var(X),
   Flags = resolve_native_endianess(Flags0),
-  Offset = mk_var(reg),
+  Offset = mk_var(reg_gcsafe),
   Base = mk_var(reg),
   {Name, Args} =
     case Size of
@@ -860,7 +860,7 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
 	   Instructions], Env) ->
   Dst = mk_var(X),
   Flags = resolve_native_endianess(Flags0),
-  Offset = mk_var(reg),
+  Offset = mk_var(reg_gcsafe),
   Base = mk_var(reg),
   {Name, Args} =
     case Size of
@@ -1505,7 +1505,10 @@ clone_dst(Dest) ->
   New = 
     case hipe_icode:is_reg(Dest) of
       true ->
-	mk_var(reg);
+	case hipe_icode:reg_is_gcsafe(Dest) of
+	  true -> mk_var(reg_gcsafe);
+	  false -> mk_var(reg)
+	end;
       false ->
 	true = hipe_icode:is_var(Dest),	      
 	mk_var(new)
@@ -2126,7 +2129,12 @@ mk_var(reg) ->
   T = hipe_gensym:new_var(icode),
   V = (5*T)+4,
   hipe_gensym:update_vrange(icode,V),
-  hipe_icode:mk_reg(V).
+  hipe_icode:mk_reg(V);
+mk_var(reg_gcsafe) ->
+  T = hipe_gensym:new_var(icode),
+  V = (5*T)+4, % same namespace as 'reg'
+  hipe_gensym:update_vrange(icode,V),
+  hipe_icode:mk_reg_gcsafe(V).
 
 %%-----------------------------------------------------------------------
 %% Make an icode label of proper type
diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl
index 24b7ac4783..bc3403b0c5 100644
--- a/lib/hipe/icode/hipe_icode.erl
+++ b/lib/hipe/icode/hipe_icode.erl
@@ -515,10 +515,12 @@
 	 annotate_variable/2,  %% annotate_var_or_reg(VarOrReg, Type)
 	 unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg)
 	 mk_reg/1,               %% mk_reg(Id)
+	 mk_reg_gcsafe/1,        %% mk_reg_gcsafe(Id)
 	 mk_fvar/1,              %% mk_fvar(Id)
 	 mk_new_var/0,           %% mk_new_var()
 	 mk_new_fvar/0,          %% mk_new_fvar()
 	 mk_new_reg/0,           %% mk_new_reg()
+	 mk_new_reg_gcsafe/0,    %% mk_new_reg_gcsafe()
 	 mk_phi/1,               %% mk_phi(Id)
 	 mk_phi/2                %% mk_phi(Id, ArgList)
 	]).
@@ -1260,14 +1262,22 @@ is_var(_) -> false.
 -spec mk_reg(non_neg_integer()) -> #icode_variable{kind::'reg'}.
 mk_reg(V) -> #icode_variable{name=V, kind=reg}.
 
--spec reg_name(#icode_variable{kind::'reg'}) -> non_neg_integer().
-reg_name(#icode_variable{name=Name, kind=reg}) -> Name.
+-spec mk_reg_gcsafe(non_neg_integer()) -> #icode_variable{kind::'reg_gcsafe'}.
+mk_reg_gcsafe(V) -> #icode_variable{name=V, kind=reg_gcsafe}.
 
--spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'.
-reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now
+-spec reg_name(#icode_variable{kind::'reg'|'reg_gcsafe'})
+	      -> non_neg_integer().
+reg_name(#icode_variable{name=Name, kind=reg})        -> Name;
+reg_name(#icode_variable{name=Name, kind=reg_gcsafe}) -> Name.
+
+-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false';
+		   (#icode_variable{kind::'reg_gcsafe'}) -> 'true'.
+reg_is_gcsafe(#icode_variable{kind=reg})        -> false;
+reg_is_gcsafe(#icode_variable{kind=reg_gcsafe}) -> true.
 
 -spec is_reg(icode_argument()) -> boolean().
-is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(#icode_variable{kind=reg})        -> true;
+is_reg(#icode_variable{kind=reg_gcsafe}) -> true;
 is_reg(_) -> false.
 
 -spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}.
@@ -1676,6 +1686,16 @@ mk_new_reg() ->
   mk_reg(hipe_gensym:get_next_var(icode)).
 
 %%
+%% @doc Makes a new gcsafe register; that is, a register that is allowed to be
+%% live over calls and other operations that might cause GCs and thus move heap
+%% data around.
+%%
+
+-spec mk_new_reg_gcsafe() -> icode_reg().
+mk_new_reg_gcsafe() ->
+  mk_reg_gcsafe(hipe_gensym:get_next_var(icode)).
+
+%%
 %% @doc Makes a new label.
 %%
 
diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl
index 380ddd8371..7ed80a9ed4 100644
--- a/lib/hipe/icode/hipe_icode.hrl
+++ b/lib/hipe/icode/hipe_icode.hrl
@@ -41,9 +41,9 @@
 
 -type variable_annotation() :: {atom(), any(), fun((any()) -> string())}.
 
--record(icode_variable, {name :: non_neg_integer(), 
-			 kind :: 'var' | 'reg' | 'fvar',
-			 annotation = [] :: [] | variable_annotation()}). 
+-record(icode_variable, {name :: non_neg_integer(),
+			 kind :: 'var' | 'reg' | 'reg_gcsafe' | 'fvar',
+			 annotation = [] :: [] | variable_annotation()}).
 
 %%---------------------------------------------------------------------
 %% Type declarations for Icode instructions
@@ -66,7 +66,7 @@
 -type icode_funcall()   :: mfa() | icode_primop().
 
 -type icode_var()	:: #icode_variable{kind::'var'}.
--type icode_reg()	:: #icode_variable{kind::'reg'}.
+-type icode_reg()	:: #icode_variable{kind::'reg'|'reg_gcsafe'}.
 -type icode_fvar()	:: #icode_variable{kind::'fvar'}.
 -type icode_argument()	:: #icode_const{} | #icode_variable{}.
 -type icode_term_arg()	:: icode_var() | #icode_const{}.
diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl
index 51e2855108..e61529a1bb 100644
--- a/lib/hipe/icode/hipe_icode_liveness.erl
+++ b/lib/hipe/icode/hipe_icode_liveness.erl
@@ -77,6 +77,7 @@ print_var(#icode_variable{name=V, kind=Kind, annotation=T}) ->
   case Kind of
     var -> io:format("v~p", [V]);
     reg -> io:format("r~p", [V]);
+    reg_gcsafe -> io:format("rs~p", [V]);
     fvar -> io:format("fv~p", [V])
   end,
   case T of
diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl
index 5b017dca32..33d1e62884 100644
--- a/lib/hipe/icode/hipe_icode_pp.erl
+++ b/lib/hipe/icode/hipe_icode_pp.erl
@@ -230,7 +230,10 @@ pp_arg(Dev, Arg) ->
 	  case hipe_icode:is_reg(Arg) of
 	    true ->
 	      N = hipe_icode:reg_name(Arg),
-	      io:format(Dev, "r~p", [N]);
+	      case hipe_icode:reg_is_gcsafe(Arg) of
+		true  -> io:format(Dev, "rs~p", [N]);
+		false -> io:format(Dev, "r~p", [N])
+	      end;
 	    false ->
 	      N = hipe_icode:fvar_name(Arg),
 	      io:format(Dev, "fv~p", [N])