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

Make it possible for the user to set a process_description 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 description 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.
dgud · Oct 9, 2023 · 6719c90 · 6719c90
1 parent 67f87be
commit 6719c90
Show file tree

Hide file tree

Showing 10 changed files with 344 additions and 128 deletions.
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
@@ -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,24 @@ 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_process_description, [Pid]) of
+                {error, _} ->
+                    io_lib:format("~p",[Pid]);
+                undefined ->
+                    io_lib:format("~p",[Pid]);
+                Id ->
+                    io_lib:format("~tp (~p)",[Id, Pid])
+            end;
+        {registered_name, Registered} ->
+            io_lib:format("~tp (~p)",[Registered, Pid]);
+        undefined ->
+            throw(process_undefined)
+    end.
+
 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,20 @@ 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)
+	_ ->
+            case proc_lib:get_process_description(P) of
+                undefined ->
+                    pid_to_list(P);
+                Id when is_binary(Id) ->
+                    case unicode:characters_to_list(Id) of
+                        {error, _, _} ->
+                            io_lib:format("~0.tp", [Id]);
+                        StringId ->
+                            StringId
+                    end;
+                Id ->
+                    io_lib:format("~0.tp", [Id])
+            end
     end;
 format(P) when is_port(P) ->
     case erlang:port_info(P, id) of

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_description'},
+          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_description'}, 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/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml
@@ -159,6 +159,17 @@
       </desc>
     </func>
 
+    <func>
+      <name name="get_process_description" arity="1" since="OTP 26.2"/>
+      <fsummary>Returns the user set process description.</fsummary>
+      <desc>
+        <p>Returns <c>undefined</c> or the description for the process
+        <anno>Pid</anno> set with <seemfa marker="#set_process_description/1">
+        <c>proc_lib:set_process_description/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,21 @@ init(Parent) ->
       </desc>
     </func>
 
+    <func>
+      <name name="set_process_description" arity="1" since="OTP 26.2"/>
+      <fsummary>Set process description.</fsummary>
+      <desc>
+        <p>Set a description for the current process.
+        The primary use is to aid debugging of non registered processes.
+        </p>
+        <p>
+          Use <seemfa marker="#get_process_description/1">
+          <c>proc_lib:get_process_description/1</c></seemfa> to lookup the
+          a process description.
+        </p>
+      </desc>
+    </func>
+
     <func>
       <name name="spawn" arity="1" since=""/>
       <name name="spawn" arity="2" since=""/>

diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
@@ -672,7 +672,11 @@ mfa_string(X) ->
     w(X).
 
 display_info(Pid) ->
-    case pinfo(Pid) of
+    case pinfo(Pid, [initial_call, current_function, reductions, message_queue_len,
+                     heap_size, stack_size, registered_name,
+                     {dictionary, '$process_description'},
+                     {dictionary, '$initial_call'}])
+    of
 	undefined -> {0,0,0,0};
 	Info ->
 	    Call = initial_call(Info),
@@ -689,17 +693,32 @@ display_info(Pid) ->
 	    iformat(w(Pid), mfa_string(Call),
 		    w(HS),
 		    w(Reds), w(LM)),
-	    iformat(case fetch(registered_name, Info) of
-			0 -> "";
-			X -> io_lib:format("~tw", [X])
-		    end,
+	    iformat(fetch_name(fetch(registered_name, Info), Info),
 		    mfa_string(Curr),
 		    w(SS),
 		    "",
 		    ""),
 	    {Reds, LM, HS, SS}
     end.
 
+fetch_name([], Info) ->
+    case fetch({dictionary, '$process_description'}, Info) of
+        undefined -> "";
+        Id -> format_name(Id)
+    end;
+fetch_name(Reg, _) ->
+    Reg.
+
+format_name(Id) when is_list(Id); is_binary(Id) ->
+    case unicode:characters_to_binary(Id) of
+        {error, _, _} ->
+            io_lib:format("~0.tp", [Id]);
+        BinString ->
+            BinString
+    end;
+format_name(TermId) ->
+    io_lib:format("~0.tp", [TermId]).
+
 %% We have to do some assumptions about the initial call.
 %% If the initial call is proc_lib:init_p/3,5 we can find more information
 %% calling the function proc_lib:initial_call/1.
@@ -728,6 +747,13 @@ pinfo(Pid) ->
 	false -> process_info(Pid)
     end.
 
+pinfo(Pid, What) ->
+    case is_alive() of
+	true -> rpc:call(node(Pid), erlang, process_info, [Pid, What]);
+	false -> process_info(Pid, What)
+    end.
+
+
 fetch(Key, Info) ->
     case lists:keyfind(Key, 1, Info) of
 	{_, Val} -> Val;