Add user tag spreading functionality to VM and use in file

User tags in a dynamic trace enabled VM are spread throughout the system
in the same way as seq_trace tokens. This is used by the file module
and various other modules to get hold of the tag from the user process
without changing the protocol.

1 files changed, 35 insertions, 0 deletions

diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index a7ce17eb53..260f216725 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -614,6 +614,10 @@ type(erlang, adler32_combine, 3, Xs) ->
 type(erlang, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias
 type(erlang, append_element, 2, Xs) ->
   strict(arg_types(erlang, append_element, 2), Xs, fun (_) -> t_tuple() end);
+type(erlang, append_vm_utag_data, 1, Xs) ->
+  strict(arg_types(erlang, append_vm_utag_data, 1), 
+	 Xs, 
+	 fun(_) -> t_iodata() end);
 type(erlang, apply, 2, Xs) ->
   Fun = fun ([X, _Y]) -> 
 	    case t_is_fun(X) of
@@ -800,6 +804,10 @@ type(erlang, get_module_info, 2, Xs) ->
 type(erlang, get_stacktrace, 0, _) ->
   t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()]),
 		  t_list()]));
+type(erlang, get_utag, 0, _) ->
+  t_sup(t_binary(), t_atom('undefined'));
+type(erlang, get_utag_data, 0, _) ->
+  t_sup(t_binary(), t_atom('undefined'));
 type(erlang, group_leader, 0, _) -> t_pid();
 type(erlang, group_leader, 2, Xs) ->
   strict(arg_types(erlang, group_leader, 2), Xs,
@@ -1186,6 +1194,10 @@ type(erlang, port_set_data, 2, Xs) ->
   strict(arg_types(erlang, port_set_data, 2), Xs,
 	 fun (_) -> t_atom('true') end);
 type(erlang, pre_loaded, 0, _) -> t_list(t_atom());
+type(erlang, prepend_vm_utag_data, 1, Xs) ->
+  strict(arg_types(erlang, prepend_vm_utag_data, 1), 
+	 Xs, 
+	 fun(_) -> t_iodata() end);
 type(erlang, process_display, 2, _) -> t_atom('true');
 type(erlang, process_flag, 2, Xs) ->
   T_process_flag_returns = t_sup([t_boolean(), t_atom(), t_non_neg_integer()]),
@@ -1303,6 +1315,9 @@ type(erlang, purge_module, 1, Xs) ->
 	 fun (_) -> t_atom('true') end);
 type(erlang, put, 2, Xs) ->
   strict(arg_types(erlang, put, 2), Xs, fun (_) -> t_any() end);
+type(erlang, put_utag, 1, Xs) ->
+  strict(arg_types(erlang, put_utag, 1), Xs, 
+	 fun(_) -> t_sup(t_binary(), t_atom('undefined')) end);
 type(erlang, raise, 3, _) -> t_none();
 type(erlang, read_timer, 1, Xs) ->
   strict(arg_types(erlang, read_timer, 1), Xs,
@@ -1312,6 +1327,8 @@ type(erlang, ref_to_list, 1, Xs) ->
 type(erlang, register, 2, Xs) ->
   strict(arg_types(erlang, register, 2), Xs, fun (_) -> t_atom('true') end);
 type(erlang, registered, 0, _) -> t_list(t_atom());
+type(erlang, restore_utag, 1, Xs) ->
+  strict(arg_types(erlang, restore_utag, 1), Xs, fun(_) -> t_atom('true') end);
 type(erlang, resume_process, 1, Xs) ->
   strict(arg_types(erlang, resume_process, 1), Xs,
 	 fun (_) -> t_any() end); %% TODO: overapproximation -- fix this
@@ -1426,6 +1443,10 @@ type(erlang, spawn_opt, 4, Xs) ->
 type(erlang, split_binary, 2, Xs) ->
   strict(arg_types(erlang, split_binary, 2), Xs,
 	 fun (_) -> t_tuple([t_binary(), t_binary()]) end);
+type(erlang, spread_utag, 1, Xs) ->
+  strict(arg_types(erlang, spread_utag, 1), Xs, 
+	 fun(_) -> t_sup(t_tuple([t_non_neg_integer(), t_sup(t_binary(), t_nil())]),
+			 t_atom('true')) end);
 type(erlang, start_timer, 3, Xs) ->
   strict(arg_types(erlang, start_timer, 3), Xs, fun (_) -> t_reference() end);
 type(erlang, statistics, 1, Xs) ->
@@ -3422,6 +3443,8 @@ arg_types(erlang, append, 2) ->
   arg_types(erlang, '++', 2);
 arg_types(erlang, append_element, 2) ->
   [t_tuple(), t_any()];
+arg_types(erlang, append_vm_utag_data, 1) ->
+  [t_iodata()];
 arg_types(erlang, apply, 2) ->
   [t_sup(t_tuple([t_module(),
 		  t_atom()]),
@@ -3547,6 +3570,10 @@ arg_types(erlang, get_module_info, 1) ->
   [t_atom()];
 arg_types(erlang, get_module_info, 2) ->
   [t_atom(), t_module_info_2()];
+arg_types(erlang, get_utag, 0) ->
+  [];
+arg_types(erlang, get_utag_data, 0) ->
+  [];
 arg_types(erlang, group_leader, 0) ->
   [];
 arg_types(erlang, group_leader, 2) ->
@@ -3763,6 +3790,8 @@ arg_types(erlang, port_set_data, 2) ->
   [t_sup(t_port(), t_atom()), t_any()];
 arg_types(erlang, pre_loaded, 0) ->
   [];
+arg_types(erlang, prepend_vm_utag_data, 1) ->
+  [t_iodata()];
 arg_types(erlang, process_display, 2) ->
   [t_pid(), t_atom('backtrace')];
 arg_types(erlang, process_flag, 2) ->
@@ -3789,6 +3818,8 @@ arg_types(erlang, purge_module, 1) ->
   [t_atom()];
 arg_types(erlang, put, 2) ->
   [t_any(), t_any()];
+arg_types(erlang, put_utag, 1) ->
+  [t_sup(t_binary(), t_atom('undefined'))];
 arg_types(erlang, raise, 3) ->
   OldStyleType = t_list(t_tuple([t_atom(), t_atom(),
 				 t_sup([t_arity(), t_list()])])),
@@ -3802,6 +3833,8 @@ arg_types(erlang, register, 2) ->
   [t_atom(), t_sup(t_port(), t_pid())];
 arg_types(erlang, registered, 0) ->
   [];
+arg_types(erlang, restore_utag, 1) ->
+  [t_sup(t_tuple([t_non_neg_integer(), t_sup(t_binary(), t_nil())]), t_atom('true'))];
 arg_types(erlang, resume_process, 1) ->
   [t_pid()]; % intended for debugging only
 arg_types(erlang, round, 1) ->
@@ -3860,6 +3893,8 @@ arg_types(erlang, spawn_opt, 4) ->
   [t_node(), t_atom(), t_list(), t_list(t_spawn_options())];
 arg_types(erlang, split_binary, 2) ->
   [t_binary(), t_non_neg_integer()];
+arg_types(erlang, spread_utag, 1) ->
+  [t_boolean()];
 arg_types(erlang, start_timer, 3) ->
   [t_non_neg_integer(), t_sup(t_pid(), t_atom()), t_any()];
 arg_types(erlang, statistics, 1) ->