Merge pull request atomvm#525 from pguyot/w17/fix-fun-external-and-apply

Fix call and encoding/decoding of function references

Fix a bug where call of function references would fail
Fix a warning related to encoding of function references Implement decoding of
function references

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

Author: bettio

src/libAtomVM/bif.c

@@ -116,6 +116,13 @@ term bif_erlang_is_boolean_1(Context *ctx, term arg1)
     return (arg1 == TRUE_ATOM || arg1 == FALSE_ATOM) ? TRUE_ATOM : FALSE_ATOM;
 }
 
+term bif_erlang_is_function_1(Context *ctx, term arg1)
+{
+    UNUSED(ctx);
+
+    return term_is_function(arg1) ? TRUE_ATOM : FALSE_ATOM;
+}
+
 term bif_erlang_is_integer_1(Context *ctx, term arg1)
 {
     UNUSED(ctx);

src/libAtomVM/bif.h

@@ -50,6 +50,7 @@ term bif_erlang_length_1(Context *ctx, int live, term arg1);
 term bif_erlang_is_atom_1(Context *ctx, term arg1);
 term bif_erlang_is_binary_1(Context *ctx, term arg1);
 term bif_erlang_is_boolean_1(Context *ctx, term arg1);
+term bif_erlang_is_function_1(Context *ctx, term arg1);
 term bif_erlang_is_integer_1(Context *ctx, term arg1);
 term bif_erlang_is_list_1(Context *ctx, term arg1);
 term bif_erlang_is_number_1(Context *ctx, term arg1);

src/libAtomVM/bifs.gperf

@@ -40,6 +40,7 @@ erlang:get/1, bif_erlang_get_1, false
 erlang:is_atom/1, bif_erlang_is_atom_1, false
 erlang:is_binary/1, bif_erlang_is_binary_1, false
 erlang:is_boolean/1, bif_erlang_is_boolean_1, false
+erlang:is_function/1, bif_erlang_is_function_1, false
 erlang:is_integer/1, bif_erlang_is_integer_1, false
 erlang:is_list/1, bif_erlang_is_list_1, false
 erlang:is_number/1, bif_erlang_is_number_1, false

src/libAtomVM/externalterm.c

@@ -373,7 +373,17 @@ static int serialize_term(Context *ctx, uint8_t *buf, term t)
             k += serialize_term(ctx, IS_NULL_PTR(buf) ? NULL : buf + k, value);
         }
         return k;
-
+    } else if (term_is_function(t)) {
+        if (!IS_NULL_PTR(buf)) {
+            buf[0] = EXPORT_EXT;
+        }
+        size_t k = 1;
+        const term *boxed_value = term_to_const_term_ptr(t);
+        for (size_t i = 1; i <= 3; ++i) {
+            term mfa = boxed_value[i];
+            k += serialize_term(ctx, IS_NULL_PTR(buf) ? NULL : buf + k, mfa);
+        }
+        return k;
     } else {
         fprintf(stderr, "Unknown external term type: %" TERM_U_FMT "\n", t);
         AVM_ABORT();
@@ -780,6 +790,7 @@ static int calculate_heap_usage(const uint8_t *external_term_buf, size_t remaini
             }
             int heap_usage = 1;
             int buf_pos = 1;
+            remaining -= 1;
             for (int i = 0; i < 3; i++) {
                 int element_size = 0;
                 int u = calculate_heap_usage(external_term_buf + buf_pos, remaining, &element_size, copy, ctx);
@@ -796,7 +807,7 @@ static int calculate_heap_usage(const uint8_t *external_term_buf, size_t remaini
             }
 
             *eterm_size = buf_pos;
-            return FUNCTION_REFERENCE_SIZE;
+            return heap_usage;
         }
 
         case MAP_EXT: {

src/libAtomVM/opcodesswitch.h

@@ -762,7 +762,7 @@ typedef union
         AtomString function_name = globalcontext_atomstring_from_term(mod->global, index_or_function); \
         struct Nif *nif = (struct Nif *) nifs_get(module_name, function_name, fun_arity); \
         if (!IS_NULL_PTR(nif)) {                                        \
-            term return_value = nif->nif_ptr(ctx, arity, ctx->x);       \
+            term return_value = nif->nif_ptr(ctx, fun_arity, ctx->x);   \
             if (UNLIKELY(term_is_invalid_term(return_value))) {         \
                 HANDLE_ERROR();                                         \
             }                                                           \
@@ -774,7 +774,7 @@ typedef union
             if (IS_NULL_PTR(fun_module)) {                              \
                 HANDLE_ERROR();                                         \
             }                                                           \
-            label = module_search_exported_function(fun_module, function_name, arity); \
+            label = module_search_exported_function(fun_module, function_name, fun_arity); \
             if (UNLIKELY(label == 0)) {                                 \
                 HANDLE_ERROR();                                         \
             }                                                           \

tests/erlang_tests/test_binary_to_term.erl

@@ -20,7 +20,7 @@
 
 -module(test_binary_to_term).
 
--export([start/0]).
+-export([start/0, apply/2, apply/3]).
 
 start() ->
     test_reverse(foo, <<131, 100, 0, 3, 102, 111, 111>>),
@@ -61,6 +61,7 @@ start() ->
             57, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 48,
             49, 50, 51, 52, 53>>
     ),
+    ok = test_external_function(),
 
     {32768, 6} = erlang:binary_to_term(<<131, 98, 0, 0, 128, 0, 127>>, [used]),
     test_catentate_and_split([foo, bar, 128, {foo, bar}, [a, b, c, {d}]]),
@@ -138,6 +139,36 @@ mutate_bin(Bin, I) ->
     I2 = Ith bxor 16#FF,
     <<Prefix/binary, I2:8/integer-unsigned, Rest/binary>>.
 
+test_external_function() ->
+    Bin = term_to_binary([fun ?MODULE:apply/2, fun ?MODULE:apply/3]),
+    Bin =
+        <<131, 108, 0, 0, 0, 2, 113, 100, 0, 19, 116, 101, 115, 116, 95, 98, 105, 110, 97, 114, 121,
+            95, 116, 111, 95, 116, 101, 114, 109, 100, 0, 5, 97, 112, 112, 108, 121, 97, 2, 113,
+            100, 0, 19, 116, 101, 115, 116, 95, 98, 105, 110, 97, 114, 121, 95, 116, 111, 95, 116,
+            101, 114, 109, 100, 0, 5, 97, 112, 112, 108, 121, 97, 3, 106>>,
+    [Fun2, Fun3] = binary_to_term(Bin),
+    true = is_function(Fun2),
+    true = is_function(Fun3),
+    42 = Fun2(fun() -> 42 end, []),
+    42 = Fun3(?MODULE, apply, [fun() -> 42 end, []]),
+    42 = Fun3(?MODULE, apply, [Fun2, [fun() -> 42 end, []]]),
+    ok.
+
+% We don't have access to erlang module in tests.
+apply(F, []) ->
+    F();
+apply(F, [X]) ->
+    F(X);
+apply(F, [X, Y]) ->
+    F(X, Y).
+
+apply(M, F, []) ->
+    M:F();
+apply(M, F, [X]) ->
+    M:F(X);
+apply(M, F, [X, Y]) ->
+    M:F(X, Y).
+
 expect_badarg(Fun) ->
     try
         Fun(),