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
Also add is_function bif for OTP21

Signed-off-by: Paul Guyot <[email protected]>

Author: pguyot

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

@@ -758,7 +758,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();                                         \
             }                                                           \
@@ -770,7 +770,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(),