Add (and use) proc_lib:set(and get)_label/1

Make it possible for the user to set a process label which can be used in tools and crash reports to identity processes but it doesn't have to be unique, as an registered name needs to be. The process label can any term, for example {worker, 1..N}, {pool_process, 1..N} or something entirely different to identify process that use general code. While at it optimize fetching process info, so we don't have to (rpc:) call the process_info(..) several times.
nyczol · Nov 17, 2023 · c4ae057 · c4ae057
1 parent 67f87be
commit c4ae057
Show file tree

Hide file tree

Showing 14 changed files with 395 additions and 136 deletions.
diff --git a/lib/kernel/test/logger_legacy_SUITE.erl b/lib/kernel/test/logger_legacy_SUITE.erl
@@ -190,6 +190,7 @@ sasl_reports(Config) ->
                      [[{initial_call,_},
                        {pid,ChPid},
                        {registered_name,[]},
+                       {process_label, undefined},
                        {error_info,{error,{badmatch,b},_}},
                        {ancestors,_},
                        {message_queue_len,_},
@@ -203,6 +204,7 @@ sasl_reports(Config) ->
                        {reductions,_}],
                       [{neighbour,[{pid,Neighbour},
                                    {registered_name,_},
+                                   {process_label, undefined},
                                    {initial_call,_},
                                    {current_function,_},
                                    {ancestors,_},

diff --git a/lib/observer/doc/src/observer_ug.xml b/lib/observer/doc/src/observer_ug.xml
@@ -163,6 +163,8 @@
     <taglist>
       <tag>Pid</tag>
       <item><p>The process identifier.</p></item>
+      <tag>Description</tag>
+      <item><p>Registered name, <seemfa marker="stdlib:proc_lib#set_label/1">process label</seemfa> or initial function.</p></item>
       <tag>Reds</tag>
       <item><p>The number of reductions executed on the process. 
       This can be presented as accumulated values or as values since the last update.</p></item>

diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl
@@ -225,7 +225,8 @@ proc_format(Modifier, #field_widths{init_func = InitFunc, reds = Reds,
     "~" ++ i2l(MsgQ) ++ "w "
     "~-" ++ i2l(CurrFunc) ++ Modifier ++ "s~n".
 
-
+to_string(Other,_Modifier) when is_binary(Other) ->
+    Other;
 to_string({M,F,A},Modifier) ->
     io_lib:format("~w:~"++Modifier++"w/~w",[M,F,A]);
 to_string(Other,Modifier) ->

diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl
@@ -165,7 +165,7 @@ create_list_box(Panel, Holder) ->
 		   end,
     Scale = observer_wx:get_scale(),
     ListItems = [{"Pid", ?wxLIST_FORMAT_CENTRE,  Scale*120},
-		 {"Name or Initial Func", ?wxLIST_FORMAT_LEFT, Scale*200},
+		 {"Description", ?wxLIST_FORMAT_LEFT, Scale*200},
 %%		 {"Time", ?wxLIST_FORMAT_CENTRE, Scale*50},
 		 {"Reds", ?wxLIST_FORMAT_RIGHT, Scale*100},
 		 {"Memory", ?wxLIST_FORMAT_RIGHT, Scale*100},
@@ -665,29 +665,61 @@ merge_fun(Col) ->
     fun(A,B) -> lists:keymerge(KeyField, A, B) end.
 
 
+%% Assumes that there are many undescribed MFA processes.
+%% So we sort them separately, to not create temporary bin-strings
+%% that will create a lot of garbage
+
 sort_name(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) ->
     A =< B;
 sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B})
   when is_atom(A), is_atom(B) ->
     A =< B;
-sort_name(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}})
-  when is_atom(Reg) ->
-    Reg < M;
-sort_name(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg})
-  when is_atom(Reg) ->
-    M < Reg.
+sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(A), is_binary(B) ->
+    A =< B;
+sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(A), is_atom(B) ->
+    A =< atom_to_binary(B);
+sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(B), is_atom(A) ->
+    atom_to_binary(A) =< B;
+sort_name(_, #etop_proc_info{name={_,_,_}}) ->
+    true;
+sort_name(#etop_proc_info{name={_,_,_}}, _) ->
+    false.
+
+%% sort_name(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}})
+%%   when is_atom(Reg) ->
+%%     Reg < M;
+%% sort_name(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg})
+%%   when is_atom(Reg) ->
+%%     M < Reg.
 
 sort_name_rev(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) ->
     A >= B;
 sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B})
   when is_atom(A), is_atom(B) ->
     A >= B;
-sort_name_rev(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}})
-  when is_atom(Reg) ->
-    Reg >= M;
-sort_name_rev(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg})
-  when is_atom(Reg) ->
-    M >= Reg.
+sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(A), is_binary(B) ->
+    A >= B;
+sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(A), is_atom(B) ->
+    A >= atom_to_binary(B);
+sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B})
+  when is_binary(B), is_atom(A) ->
+    atom_to_binary(A) >= B;
+sort_name_rev(_, #etop_proc_info{name={_,_,_}}) ->
+    false;
+sort_name_rev(#etop_proc_info{name={_,_,_}}, _) ->
+    true.
+
+%% sort_name_rev(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}})
+%%   when is_atom(Reg) ->
+%%     Reg >= M;
+%% sort_name_rev(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg})
+%%   when is_atom(Reg) ->
+%%     M >= Reg.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -707,6 +739,7 @@ get_pids(From, Indices, ProcInfo) ->
 
 get_name_or_pid(From, Indices, ProcInfo) ->
     Get = fun(#etop_proc_info{name=Name}) when is_atom(Name) -> Name;
+             (#etop_proc_info{name=Name}) when is_atom(Name) -> Name;
 	     (#etop_proc_info{pid=Pid}) -> Pid
 	  end,
     Processes = [Get(array:get(I, ProcInfo)) || I <- Indices],
@@ -718,6 +751,20 @@ get_row(From, Row, pid, Info) ->
 	      false -> {ok, get_procinfo_data(?COL_PID, array:get(Row, Info))}
 	  end,
     From ! {self(), Pid};
+get_row(From, Row, ?COL_NAME, Info) ->
+    String = case Row >= array:size(Info) of
+                 true ->
+                     "";
+                 false ->
+                     ProcInfo = array:get(Row, Info),
+                     case get_procinfo_data(?COL_NAME, ProcInfo) of
+                         Name when is_binary(Name) ->
+                             Name;
+                         AtomOrMFA ->
+                             observer_lib:to_str(AtomOrMFA)
+                     end
+             end,
+    From ! {self(), String};
 get_row(From, Row, Col, Info) ->
     Data = case Row >= array:size(Info) of
 	       true ->

diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
@@ -54,12 +54,8 @@ start(Process, ParentFrame, Parent) ->
 init([Pid, ParentFrame, Parent]) ->
     try
 	Table = ets:new(observer_expand,[set,public]),
-	Title=case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, registered_name]) of
-		  [] -> io_lib:format("~p",[Pid]);
-		  {registered_name, Registered} -> io_lib:format("~tp (~p)",[Registered, Pid]);
-		  undefined -> throw(process_undefined)
-	      end,
-    Scale = observer_wx:get_scale(),
+	Title = get_name(Pid),
+        Scale = observer_wx:get_scale(),
 	Frame=wxFrame:new(ParentFrame, ?wxID_ANY, [atom_to_list(node(Pid)), $:, Title],
 			  [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {Scale * 850, Scale * 600}}]),
 	MenuBar = wxMenuBar:new(),
@@ -449,6 +445,34 @@ filter_monitor_info() ->
 	    [Id || {_Type, Id} <- Ms] % Type is process or port
     end.
 
+%% NOTE: intentionally throws error
+get_name(Pid) ->
+    case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, registered_name]) of
+        [] ->
+            case observer_wx:try_rpc(node(Pid), proc_lib, get_label, [Pid]) of
+                {error, _} ->
+                    io_lib:format("~w",[Pid]);
+                undefined ->
+                    io_lib:format("~w",[Pid]);
+                Label ->
+                    format_label(Label, Pid)
+            end;
+        {registered_name, Registered} ->
+            io_lib:format("~0.tp ~w",[Registered, Pid]);
+        undefined ->
+            throw(process_undefined)
+    end.
+
+format_label(Id, Pid) when is_list(Id); is_binary(Id) ->
+    case unicode:characters_to_binary(Id) of
+        {error, _, _} ->
+            io_lib:format("~0.tp ~w", [Id, Pid]);
+        BinString ->
+            io_lib:format("~ts ~w", [BinString, Pid])
+    end;
+format_label(Id, Pid) ->
+    io_lib:format("~0.tp ~w", [Id, Pid]).
+
 stringify_bins(Data) ->
     Bins = proplists:get_value(binary, Data),
     [lists:flatten(io_lib:format("<< ~s, refc ~w>>", [observer_lib:to_str({bytes,Sz}),Refc]))

diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
@@ -557,16 +557,16 @@ code_change(_, _, State) ->
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 try_rpc(Node, Mod, Func, Args) ->
-    case
-	rpc:call(Node, Mod, Func, Args) of
-	{badrpc, Reason} ->
+    try erpc:call(Node, Mod, Func, Args)
+    catch
+        error:{erpc, Reason} ->
 	    error_logger:error_report([{node, Node},
 				       {call, {Mod, Func, Args}},
 				       {reason, {badrpc, Reason}}]),
 	    observer ! {nodedown, Node},
 	    error({badrpc, Reason});
-	Res ->
-	    Res
+        Class:Reason ->
+            {error, {Class,Reason}}
     end.
 
 return_to_localnode(Frame, Node) ->

diff --git a/lib/runtime_tools/src/appmon_info.erl b/lib/runtime_tools/src/appmon_info.erl
@@ -710,7 +710,14 @@ format(P) when is_pid(P), node(P) /= node() ->
 format(P) when is_pid(P) ->
     case process_info(P, registered_name) of
 	{registered_name, Name} -> atom_to_list(Name);
-	_ -> pid_to_list(P)
+	_ ->
+            %% Needs to be unique
+            case proc_lib:get_label(P) of
+                undefined ->
+                    pid_to_list(P);
+                Label ->
+                    format_label(Label, P)
+            end
     end;
 format(P) when is_port(P) ->
     case erlang:port_info(P, id) of
@@ -722,6 +729,16 @@ format(X) ->
     io:format("What: ~p~n", [X]),
     "???".
 
+format_label(Id, Pid) when is_list(Id); is_binary(Id) ->
+    case unicode:characters_to_binary(Id) of
+        {error, _, _} ->
+            io_lib:format("~0.tp ~w", [Id, Pid]);
+        BinString ->
+            io_lib:format("~ts ~w", [BinString, Pid])
+    end;
+format_label(Id, Pid) ->
+    io_lib:format("~0.tp ~w", [Id, Pid]).
+
 
 %%----------------------------------------------------------------------
 %%**********************************************************************

diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
@@ -575,24 +575,45 @@ etop_memi() ->
 etop_collect([P|Ps], Acc) when P =:= self() ->
     etop_collect(Ps, Acc);
 etop_collect([P|Ps], Acc) ->
-    Fs = [registered_name,initial_call,memory,reductions,current_function,message_queue_len],
+    Fs = [registered_name,initial_call,
+          {dictionary, '$initial_call'}, {dictionary, '$process_label'},
+          memory,reductions,current_function,message_queue_len],
     case process_info(P, Fs) of
 	undefined ->
 	    etop_collect(Ps, Acc);
-	[{registered_name,Reg},{initial_call,Initial},{memory,Mem},
-	 {reductions,Reds},{current_function,Current},{message_queue_len,Qlen}] ->
-	    Name = case Reg of
-		       [] -> initial_call(Initial, P);
-		       _ -> Reg
+	[{registered_name,Reg},{initial_call,Initial},
+         {{dictionary, '$initial_call'}, DictInitial},
+         {{dictionary, '$process_label'}, ProcId},
+	 {memory,Mem},{reductions,Reds},
+         {current_function,Current},{message_queue_len,Qlen}
+        ] ->
+	    Name = if Reg /= "" -> Reg;
+                      ProcId /= undefined -> id_to_binary(ProcId);
+                      true -> initial_call(Initial, DictInitial)
 		   end,
 	    Info = #etop_proc_info{pid=P,mem=Mem,reds=Reds,name=Name,
 				   cf=Current,mq=Qlen},
 	    etop_collect(Ps, [Info|Acc])
     end;
 etop_collect([], Acc) -> Acc.
 
-initial_call({proc_lib, init_p, _}, Pid) ->
-    proc_lib:translate_initial_call(Pid);
+id_to_binary(Id) when is_list(Id); is_binary(Id) ->
+    case unicode:characters_to_binary(Id) of
+        {error, _, _} ->
+            unicode:characters_to_binary(io_lib:format("~0.tp", [Id]));
+        BinString ->
+            BinString
+    end;
+id_to_binary(TermId) ->
+    unicode:characters_to_binary(io_lib:format("~0.tp", [TermId])).
+
+initial_call({proc_lib, init_p, _}, DictInitial) ->
+    case DictInitial of
+        {_,_,_} = MFA ->
+            MFA;
+        undefined -> %% Fetch the default initial call
+            proc_lib:translate_initial_call([])
+    end;
 initial_call(Initial, _Pid) ->
     Initial.
 

diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src
@@ -29,5 +29,5 @@
     {applications, [kernel, stdlib]},
     {env,          []},
     {mod,          {runtime_tools, []}},
-    {runtime_dependencies, ["stdlib-3.13","mnesia-4.12","kernel-8.1",
-			    "erts-11.0"]}]}.
+    {runtime_dependencies, ["stdlib-@OTP-18789@","mnesia-4.12","kernel-8.1",
+			    "erts-@OTP-18765@"]}]}.
diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml
@@ -159,6 +159,17 @@
       </desc>
     </func>
 
+    <func>
+      <name name="get_label" arity="1" since="OTP 26.2"/>
+      <fsummary>Returns the user-set process label.</fsummary>
+      <desc>
+        <p>Returns either <c>undefined</c> or the label for the process
+        <anno>Pid</anno> set with <seemfa marker="#set_label/1">
+        <c>proc_lib:set_label/1</c></seemfa>.
+        </p>
+      </desc>
+    </func>
+
     <func>
       <name name="hibernate" arity="3" since=""/>
       <fsummary>Hibernate a process until a message is sent to it.</fsummary>
@@ -329,6 +340,23 @@ init(Parent) ->
       </desc>
     </func>
 
+    <func>
+      <name name="set_label" arity="1" since="OTP 26.2"/>
+      <fsummary>Set process label.</fsummary>
+      <desc>
+        <p>Set a label for the current process.
+        The primary purpose is to aid in debugging unregistered processes.
+        The process label can be used in tools and crash reports to identify processes
+        but it doesn't have to be unique or an atom, as a registered name needs to be.
+        The process label can be any term, for example <c>{worker_process, 1..N}</c>.
+        </p>
+        <p>
+          Use <seemfa marker="#get_label/1">
+          <c>proc_lib:get_label/1</c></seemfa> to lookup the process description.
+        </p>
+      </desc>
+    </func>
+
     <func>
       <name name="spawn" arity="1" since=""/>
       <name name="spawn" arity="2" since=""/>