Merge pull request #1547 from pguyot/w08/gc-signals

bettio · bettio · commit 3dd59d52c09d · 2025-02-19T00:48:38.000+01:00
Fix a bug related to process_info memory usage

When calling repeatedly process_info on another process, memory allocated to
create the reply tuple was never freed until the process did a garbage
collection. Fix the bug by allocating the response on a disposed heap since this
is copied to a message.

These changes are made under both the "Apache 2.0" and the "GNU Lesser General
Public License 2.1 or later" license terms (dual license).

SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -51,6 +51,8 @@ bug when handling errors from BIFs used as NIFs (when called with `CALL_EXT` and
 - Fixed potential crashes or memory leaks caused by a mistake in calculation of reference counts
 and a race condition in otp_socket code
 - Fixed an out of memory issue by forcing GC to copy data from message fragments
+- Fixed a bug where calling repeatedly `process_info` on a stopped process could cause an out of
+memory error
 
 ## [0.6.5] - 2024-10-15
 
diff --git a/src/libAtomVM/context.c b/src/libAtomVM/context.c
@@ -23,6 +23,7 @@
 #include <fenv.h>
 #include <math.h>
 
+#include "defaultatoms.h"
 #include "dictionary.h"
 #include "erl_nif.h"
 #include "erl_nif_priv.h"
@@ -194,11 +195,22 @@ void context_process_process_info_request_signal(Context *ctx, struct BuiltInAto
 {
     Context *target = globalcontext_get_process_lock(ctx->global, signal->sender_pid);
     if (target) {
-        term ret;
-        if (context_get_process_info(ctx, &ret, signal->atom)) {
-            mailbox_send_term_signal(target, TrapAnswerSignal, ret);
+        size_t term_size;
+        if (context_get_process_info(ctx, NULL, &term_size, signal->atom, NULL)) {
+            Heap heap;
+            if (UNLIKELY(memory_init_heap(&heap, term_size) != MEMORY_GC_OK)) {
+                mailbox_send_built_in_atom_signal(target, TrapExceptionSignal, OUT_OF_MEMORY_ATOM);
+            } else {
+                term ret;
+                if (context_get_process_info(ctx, &ret, NULL, signal->atom, &heap)) {
+                    mailbox_send_term_signal(target, TrapAnswerSignal, ret);
+                } else {
+                    mailbox_send_built_in_atom_signal(target, TrapExceptionSignal, ret);
+                }
+                memory_destroy_heap(&heap, ctx->global);
+            }
         } else {
-            mailbox_send_built_in_atom_signal(target, TrapExceptionSignal, ret);
+            mailbox_send_built_in_atom_signal(target, TrapExceptionSignal, BADARG_ATOM);
         }
         globalcontext_get_process_unlock(ctx->global, target);
     } // else: sender died
@@ -262,7 +274,7 @@ size_t context_size(Context *ctx)
         + memory_heap_memory_size(&ctx->heap) * BYTES_PER_TERM;
 }
 
-bool context_get_process_info(Context *ctx, term *out, term atom_key)
+bool context_get_process_info(Context *ctx, term *out, size_t *term_size, term atom_key, Heap *heap)
 {
     size_t ret_size;
     switch (atom_key) {
@@ -286,16 +298,19 @@ bool context_get_process_info(Context *ctx, term *out, term atom_key)
             break;
         }
         default:
-            *out = BADARG_ATOM;
+            if (out != NULL) {
+                *out = BADARG_ATOM;
+            }
             return false;
     }
-
-    if (UNLIKELY(memory_ensure_free(ctx, ret_size) != MEMORY_GC_OK)) {
-        *out = OUT_OF_MEMORY_ATOM;
-        return false;
+    if (term_size != NULL) {
+        *term_size = ret_size;
+    }
+    if (out == NULL) {
+        return true;
     }
 
-    term ret = term_alloc_tuple(2, &ctx->heap);
+    term ret = term_alloc_tuple(2, heap);
     switch (atom_key) {
         // heap_size size in words of the heap of the process
         case HEAP_SIZE_ATOM: {
@@ -346,7 +361,7 @@ bool context_get_process_info(Context *ctx, term *out, term atom_key)
                 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);
+                    list = term_list_prepend(monitor->monitor_obj, list, heap);
                 }
             }
             term_put_tuple_element(ret, 1, list);
diff --git a/src/libAtomVM/context.h b/src/libAtomVM/context.h
@@ -396,12 +396,14 @@ void context_process_flush_monitor_signal(Context *ctx, uint64_t ref_ticks, bool
  * @brief Get process information.
  *
  * @param ctx the context being executed
- * @param out the answer term
+ * @param out the answer term. Can be NULL if only the size matters.
+ * @param term_size the size of the answer term, in words.
  * @param atom_key the key representing the info to get
+ * @param heap the heap to allocate the answer to
  * @return \c true if successful, \c false in case of an error in which case
- * *out is filled with an exception atom
+ * *out is filled with an exception atom if it was not NULL
  */
-bool context_get_process_info(Context *ctx, term *out, term atom_key);
+bool context_get_process_info(Context *ctx, term *out, size_t *term_size, term atom_key, Heap *heap);
 
 /**
  * @brief Half-link process to another process
diff --git a/src/libAtomVM/nifs.c b/src/libAtomVM/nifs.c
@@ -2800,7 +2800,16 @@ static term nif_erlang_process_info(Context *ctx, int argc, term argv[])
 
     term ret = term_invalid_term();
     if (ctx == target) {
-        if (!context_get_process_info(ctx, &ret, item)) {
+        size_t term_size;
+        if (UNLIKELY(!context_get_process_info(ctx, NULL, &term_size, item, NULL))) {
+            globalcontext_get_process_unlock(ctx->global, target);
+            RAISE_ERROR(BADARG_ATOM);
+        }
+        if (UNLIKELY(memory_ensure_free_opt(ctx, term_size, MEMORY_CAN_SHRINK) != MEMORY_GC_OK)) {
+            globalcontext_get_process_unlock(ctx->global, target);
+            RAISE_ERROR(OUT_OF_MEMORY_ATOM);
+        }
+        if (UNLIKELY(!context_get_process_info(ctx, &ret, NULL, item, &ctx->heap))) {
             globalcontext_get_process_unlock(ctx->global, target);
             RAISE_ERROR(ret);
         }
diff --git a/tests/erlang_tests/test_heap_growth.erl b/tests/erlang_tests/test_heap_growth.erl
@@ -80,24 +80,80 @@ test_bounded_free_strategy(UseDefault) ->
     ok.
 
 test_minimum_strategy() ->
+    Parent = self(),
     {Pid1, Ref1} = spawn_opt(
         fun() ->
-            {total_heap_size, X1} = process_info(self(), total_heap_size),
+            receive
+                {step, 1} -> Parent ! ok
+            end,
+            receive
+                {step, 2} -> Parent ! ok
+            end,
             % Cannot really be 0 because we allocate more than just the list.
             ok = test_growth_bounded(10),
-            {total_heap_size, X2} = process_info(self(), total_heap_size),
+            receive
+                {step, 3} -> Parent ! ok
+            end,
+            receive
+                {step, 4} -> Parent ! ok
+            end,
             % Allocate again, this is when heap will be shrunk
             Var1 = alloc_some_heap_words(10),
-            {total_heap_size, X3} = process_info(self(), total_heap_size),
-            20 = erts_debug:flat_size(Var1),
-            true = X3 < X2,
-            true = X3 - X1 - erts_debug:flat_size(Var1) =< 10
+            receive
+                {step, 5} -> Parent ! ok
+            end,
+            receive
+                {step, 6} -> Parent ! ok
+            end,
+            20 = erts_debug:flat_size(Var1)
         end,
         [monitor, {atomvm_heap_growth, minimum}]
     ),
+    % Get heap size from the outside to have no influence on the heap
+    Pid1 ! {step, 1},
     ok =
         receive
-            {'DOWN', Ref1, process, Pid1, normal} -> ok
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    {total_heap_size, X1} = process_info(Pid1, total_heap_size),
+    Pid1 ! {step, 2},
+    ok =
+        receive
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    Pid1 ! {step, 3},
+    ok =
+        receive
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    {total_heap_size, X2} = process_info(Pid1, total_heap_size),
+    Pid1 ! {step, 4},
+    ok =
+        receive
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    Pid1 ! {step, 5},
+    ok =
+        receive
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    {total_heap_size, X3} = process_info(Pid1, total_heap_size),
+    Pid1 ! {step, 6},
+    ok =
+        receive
+            ok -> ok
+        after 1000 -> timeout
+        end,
+    true = X3 < X2,
+    true = X3 - X1 - 20 =< 10,
+    normal =
+        receive
+            {'DOWN', Ref1, process, Pid1, Reason} -> Reason
         after 500 -> timeout
         end,
     ok.
diff --git a/tests/erlang_tests/test_process_info.erl b/tests/erlang_tests/test_process_info.erl
@@ -39,12 +39,13 @@ start() ->
         receive
             {Pid, result, X} -> X
         end,
-    receive
-        {'DOWN', Ref, process, Pid, Reason} ->
-            assert(Reason =:= normal)
-    end,
+    normal =
+        receive
+            {'DOWN', Ref, process, Pid, Reason} -> Reason
+        end,
     MessageQueueLen = process_info(Pid, message_queue_len),
-    assert(MessageQueueLen =:= undefined),
+    MessageQueueLen = undefined,
+    ok = test_process_info_memory_other(),
     0.
 
 test_message_queue_len(Pid, Self) ->
@@ -64,20 +65,44 @@ test_message_queue_len(Pid, Self) ->
     end,
     {total_heap_size, TotalHeapSize2} = process_info(Pid, total_heap_size),
     {heap_size, HeapSize2} = process_info(Pid, heap_size),
-    assert(MessageQueueLen < MessageQueueLen2),
+    true = MessageQueueLen < MessageQueueLen2,
     case erlang:system_info(machine) of
         "BEAM" ->
-            assert(Memory =< Memory2),
-            assert(HeapSize =< TotalHeapSize),
-            assert(HeapSize2 =< TotalHeapSize2),
-            assert(TotalHeapSize =< TotalHeapSize2);
+            true = Memory =< Memory2,
+            true = HeapSize =< TotalHeapSize,
+            true = HeapSize2 =< TotalHeapSize2,
+            true = TotalHeapSize =< TotalHeapSize2;
         _ ->
-            assert(Memory < Memory2),
-            assert(HeapSize =< TotalHeapSize),
-            assert(HeapSize2 =< TotalHeapSize2),
-            assert(TotalHeapSize < TotalHeapSize2)
+            true = Memory < Memory2,
+            true = HeapSize =< TotalHeapSize,
+            true = HeapSize2 =< TotalHeapSize2,
+            true = TotalHeapSize =< TotalHeapSize2
     end.
 
+test_process_info_memory_other() ->
+    {Pid, Ref} = spawn_opt(
+        fun() ->
+            receive
+                quit -> ok
+            end
+        end,
+        [monitor]
+    ),
+    {total_heap_size, THS0} = process_info(Pid, total_heap_size),
+    test_process_info_memory_other_loop(Pid, THS0, 50),
+    Pid ! quit,
+    normal =
+        receive
+            {'DOWN', Ref, process, Pid, Reason} -> Reason
+        end,
+    ok.
+
+test_process_info_memory_other_loop(_Pid, _THS0, 0) ->
+    ok;
+test_process_info_memory_other_loop(Pid, THS0, N) ->
+    {total_heap_size, THS0} = process_info(Pid, total_heap_size),
+    test_process_info_memory_other_loop(Pid, THS0, N - 1).
+
 loop(undefined, Accum) ->
     receive
         {Pid, stop} ->
@@ -95,5 +120,3 @@ loop(locked, Accum) ->
 loop(Pid, Accum) ->
     Pid ! ok,
     loop(locked, Accum).
-
-assert(true) -> ok.
