Implement info links for erlang:process_info/2

Also narrow type specification of `erlang:process_info/2` Also update edown with a patch to fix crash when parsing updated doc for `erlang:process_info/2` See: - uwiger/edown#23 - erlang/otp#7576 Signed-off-by: Paul Guyot <[email protected]>
atomvm · Aug 28, 2023 · 4b87d20 · 4b87d20
1 parent 725d2f4
commit 4b87d20
Show file tree

Hide file tree

Showing 8 changed files with 69 additions and 7 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -65,6 +65,7 @@ functions that default to `?ATOMVM_NVS_NS` are deprecated now).
 - Added most format possibilities to `io:format/2` and `io_lib:format/2`
 - Added `unicode` module with `characters_to_list/1,2` and `characters_to_binary/1,2,3` functions
 - Added support for `crypto:hash/2` (ESP32 and generic_unix with openssl)
+- Added links to process_info/2
 
 ### Fixed
 - Fixed issue with formatting integers with io:format() on STM32 platform

diff --git a/doc/CMakeLists.txt b/doc/CMakeLists.txt
@@ -40,7 +40,7 @@ endforeach(SOURCE_TARGET)
 
 # Support for edoc -> markdown.
 add_custom_target(edown-escript
-    COMMAND rebar3 get-deps co edown edoc && rebar3 escriptize edown edoc
+    COMMAND rebar3 compile
     WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/edoc/edown_dep
     COMMENT "Preparing edown escript" VERBATIM
 )

diff --git a/doc/edoc/edown_dep/rebar.config b/doc/edoc/edown_dep/rebar.config
@@ -3,7 +3,7 @@
 % SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later
 
 {erl_opts, [debug_info]}.
-{deps, [edown]}.
+{deps, [{edown, {git, "https://github.com/pguyot/edown.git", {ref, "e0201c8ec6444d8d41891f0a5ed2bce42fe944d0"}}}]}.
 {plugins, [
    ex_doc
 ]}.
diff --git a/libs/estdlib/src/erlang.erl b/libs/estdlib/src/erlang.erl
@@ -193,12 +193,18 @@ send_after(Time, Dest, Msg) ->
 %%      <li><b>stack_size</b> the number of words used in the stack (integer)</li>
 %%      <li><b>message_queue_len</b> the number of messages enqueued for the process (integer)</li>
 %%      <li><b>memory</b> the estimated total number of bytes in use by the process (integer)</li>
+%%      <li><b>links</b> the list of linked processes</li>
 %% </ul>
 %% Specifying an unsupported term or atom raises a bad_arg error.
 %%
 %% @end
 %%-----------------------------------------------------------------------------
--spec process_info(Pid :: pid(), Key :: atom()) -> term().
+-spec process_info
+    (Pid :: pid(), heap_size) -> {heap_size, non_neg_integer()};
+    (Pid :: pid(), stack_size) -> {stack_size, non_neg_integer()};
+    (Pid :: pid(), message_queue_len) -> {message_queue_len, non_neg_integer()};
+    (Pid :: pid(), memory) -> {memory, non_neg_integer()};
+    (Pid :: pid(), links) -> {links, [pid()]}.
 process_info(_Pid, _Key) ->
     erlang:nif_error(undefined).
 

diff --git a/src/libAtomVM/context.c b/src/libAtomVM/context.c
@@ -32,6 +32,8 @@
 #include "smp.h"
 #include "synclist.h"
 #include "sys.h"
+#include "term.h"
+#include "utils.h"
 
 #define IMPL_EXECUTE_LOOP
 #include "opcodesswitch.h"
@@ -231,7 +233,32 @@ size_t context_size(Context *ctx)
 
 bool context_get_process_info(Context *ctx, term *out, term atom_key)
 {
-    if (UNLIKELY(memory_ensure_free(ctx, 3) != MEMORY_GC_OK)) {
+    size_t ret_size;
+    switch (atom_key) {
+        case HEAP_SIZE_ATOM:
+        case STACK_SIZE_ATOM:
+        case MESSAGE_QUEUE_LEN_ATOM:
+        case MEMORY_ATOM:
+            ret_size = TUPLE_SIZE(2);
+            break;
+        case LINKS_ATOM: {
+            struct ListHead *item;
+            size_t links_count = 0;
+            LIST_FOR_EACH (item, &ctx->monitors_head) {
+                struct Monitor *monitor = GET_LIST_ENTRY(item, struct Monitor, monitor_list_head);
+                if (monitor->ref_ticks == 0) {
+                    links_count++;
+                }
+            }
+            ret_size = TUPLE_SIZE(2) + CONS_SIZE * links_count;
+            break;
+        }
+        default:
+            *out = BADARG_ATOM;
+            return false;
+    }
+
+    if (UNLIKELY(memory_ensure_free(ctx, ret_size) != MEMORY_GC_OK)) {
         *out = OUT_OF_MEMORY_ATOM;
         return false;
     }
@@ -270,9 +297,24 @@ bool context_get_process_info(Context *ctx, term *out, term atom_key)
             break;
         }
 
+        // pids of linked processes
+        case LINKS_ATOM: {
+            term_put_tuple_element(ret, 0, LINKS_ATOM);
+            term list = term_nil();
+            struct ListHead *item;
+            LIST_FOR_EACH (item, &ctx->monitors_head) {
+                struct Monitor *monitor = GET_LIST_ENTRY(item, struct Monitor, monitor_list_head);
+                // Links are struct Monitor entries with ref_ticks equal to 0
+                if (monitor->ref_ticks == 0) {
+                    list = term_list_prepend(monitor->monitor_obj, list, &ctx->heap);
+                }
+            }
+            term_put_tuple_element(ret, 1, list);
+            break;
+        }
+
         default:
-            *out = BADARG_ATOM;
-            return false;
+            UNREACHABLE();
     }
     *out = ret;
     return true;

diff --git a/src/libAtomVM/defaultatoms.c b/src/libAtomVM/defaultatoms.c
@@ -145,6 +145,8 @@ static const char *const exports_atom = "\x7" "exports";
 
 static const char *const incomplete_atom = "\xA" "incomplete";
 
+static const char *const links_atom = "\x5" "links";
+
 void defaultatoms_init(GlobalContext *glb)
 {
     int ok = 1;
@@ -274,6 +276,8 @@ void defaultatoms_init(GlobalContext *glb)
 
     ok &= globalcontext_insert_atom(glb, incomplete_atom) == INCOMPLETE_ATOM_INDEX;
 
+    ok &= globalcontext_insert_atom(glb, links_atom) == LINKS_ATOM_INDEX;
+
     if (!ok) {
         AVM_ABORT();
     }

diff --git a/src/libAtomVM/defaultatoms.h b/src/libAtomVM/defaultatoms.h
@@ -154,7 +154,9 @@ extern "C" {
 
 #define INCOMPLETE_ATOM_INDEX 99
 
-#define PLATFORM_ATOMS_BASE_INDEX 100
+#define LINKS_ATOM_INDEX 100
+
+#define PLATFORM_ATOMS_BASE_INDEX 101
 
 #define FALSE_ATOM TERM_FROM_ATOM_INDEX(FALSE_ATOM_INDEX)
 #define TRUE_ATOM TERM_FROM_ATOM_INDEX(TRUE_ATOM_INDEX)
@@ -283,6 +285,8 @@ extern "C" {
 
 #define INCOMPLETE_ATOM TERM_FROM_ATOM_INDEX(INCOMPLETE_ATOM_INDEX)
 
+#define LINKS_ATOM TERM_FROM_ATOM_INDEX(LINKS_ATOM_INDEX)
+
 void defaultatoms_init(GlobalContext *glb);
 
 void platform_defaultatoms_init(GlobalContext *glb);

diff --git a/tests/erlang_tests/test_process_info.erl b/tests/erlang_tests/test_process_info.erl
@@ -29,6 +29,11 @@ start() ->
         ok -> ok
     end,
     test_message_queue_len(Pid, Self),
+    {links, []} = process_info(Pid, links),
+    link(Pid),
+    {links, [Self]} = process_info(Pid, links),
+    unlink(Pid),
+    {links, []} = process_info(Pid, links),
     Pid ! {Self, stop},
     _Accum =
         receive