Merge pull request #1784 from pguyot/w31/serialize-funs

Serialize and unserialize functions

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/externalterm.c

@@ -31,6 +31,7 @@
 #include "bitstring.h"
 #include "defaultatoms.h"
 #include "memory.h"
+#include "module.h"
 #include "term.h"
 #include "unicode.h"
 #include "utils.h"
@@ -49,6 +50,7 @@
 #define LIST_EXT 108
 #define BINARY_EXT 109
 #define SMALL_BIG_EXT 110
+#define NEW_FUN_EXT 112
 #define EXPORT_EXT 113
 #define MAP_EXT 116
 #define ATOM_UTF8_EXT 118
@@ -362,7 +364,7 @@ static int serialize_term(uint8_t *buf, term t, GlobalContext *glb)
             k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, value, glb);
         }
         return k;
-    } else if (term_is_function(t)) {
+    } else if (term_is_external_fun(t)) {
         if (!IS_NULL_PTR(buf)) {
             buf[0] = EXPORT_EXT;
         }
@@ -373,6 +375,50 @@ static int serialize_term(uint8_t *buf, term t, GlobalContext *glb)
             k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, mfa, glb);
         }
         return k;
+    } else if (term_is_function(t)) {
+        const term *boxed_value = term_to_const_term_ptr(t);
+        size_t num_free = (((uintptr_t) boxed_value[0]) >> 6) - 2;
+        // TODO: old_uniq is marked deprecated in OTP source likely to be removed in OTP29
+        term module, old_uniq, old_index;
+        uint32_t arity;
+        uint32_t index = term_to_int32(boxed_value[2]);
+        size_t free_index;
+        if (term_is_atom(boxed_value[1])) {
+            module = boxed_value[1];
+            arity = term_to_int32(boxed_value[3]);
+            old_index = boxed_value[4];
+            old_uniq = boxed_value[5];
+            free_index = 6;
+            num_free -= 3;
+        } else {
+            Module *mod = (Module *) boxed_value[1];
+            module = module_get_name(mod);
+            uint32_t f_old_index, f_old_uniq;
+            module_get_fun_arity_old_index_uniq(mod, index, &arity, &f_old_index, &f_old_uniq);
+            old_uniq = term_from_int(f_old_uniq);
+            old_index = term_from_int(f_old_index);
+            free_index = 3;
+        }
+
+        if (!IS_NULL_PTR(buf)) {
+            buf[0] = NEW_FUN_EXT;
+            buf[5] = arity - num_free;
+            bzero(buf + 6, 16);
+            WRITE_32_UNALIGNED(buf + 22, index);
+            WRITE_32_UNALIGNED(buf + 26, num_free);
+        }
+        size_t k = 1 + 4 + 1 + 16 + 4 + 4;
+        k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, module, glb);
+        k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, old_index, glb);
+        k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, old_uniq, glb);
+        k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, term_from_local_process_id(0), glb);
+        for (size_t i = 0; i < num_free; i++) {
+            k += serialize_term(IS_NULL_PTR(buf) ? NULL : buf + k, boxed_value[free_index + i], glb);
+        }
+        if (!IS_NULL_PTR(buf)) {
+            WRITE_32_UNALIGNED(buf + 1, k - 1);
+        }
+        return k;
     } else if (term_is_local_pid(t)) {
         if (!IS_NULL_PTR(buf)) {
             buf[0] = NEW_PID_EXT;
@@ -814,6 +860,60 @@ static term parse_external_terms(const uint8_t *external_term_buf, size_t *eterm
             }
         }
 
+        case NEW_FUN_EXT: {
+            uint32_t len = READ_32_UNALIGNED(external_term_buf + 1);
+            uint8_t arity = external_term_buf[5];
+            uint32_t index = READ_32_UNALIGNED(external_term_buf + 22);
+            uint32_t num_free = READ_32_UNALIGNED(external_term_buf + 26);
+            size_t term_size;
+            size_t offset = 30;
+            term module = parse_external_terms(external_term_buf + offset, &term_size, copy, heap, glb);
+            offset += term_size;
+            term old_index = parse_external_terms(external_term_buf + offset, &term_size, copy, heap, glb);
+            offset += term_size;
+            // TODO: old_uniq is marked deprecated in OTP source likely to be removed in OTP29
+            term old_uniq = parse_external_terms(external_term_buf + offset, &term_size, copy, heap, glb);
+            offset += term_size;
+            // skip pid
+            if (UNLIKELY(calculate_heap_usage(external_term_buf + offset, len - offset + 1, &term_size, copy) == INVALID_TERM_SIZE)) {
+                return term_invalid_term();
+            }
+            offset += term_size;
+            Module *mod = globalcontext_get_module(glb, term_to_atom_index(module));
+            if (!IS_NULL_PTR(mod)) {
+                uint32_t f_arity, f_old_index, f_old_uniq;
+                module_get_fun_arity_old_index_uniq(mod, index, &f_arity, &f_old_index, &f_old_uniq);
+                if (UNLIKELY(f_arity != (arity + num_free) || f_old_index != (uint32_t) term_to_int32(old_index) || f_old_uniq != (uint32_t) term_to_int32(old_uniq))) {
+                    mod = NULL;
+                }
+            }
+            size_t size = BOXED_FUN_SIZE + num_free;
+            if (IS_NULL_PTR(mod)) {
+                size += 3;
+            }
+            term *boxed_func = memory_heap_alloc(heap, size);
+            boxed_func[0] = ((size - 1) << 6) | TERM_BOXED_FUN;
+            size_t free_index;
+            if (IS_NULL_PTR(mod)) {
+                boxed_func[1] = module;
+                boxed_func[3] = term_from_int(arity);
+                boxed_func[4] = old_index;
+                boxed_func[5] = old_uniq;
+                free_index = 6;
+            } else {
+                boxed_func[1] = (term) mod;
+                free_index = 3;
+            }
+
+            boxed_func[2] = term_from_int(index);
+            for (uint32_t i = 0; i < num_free; i++) {
+                boxed_func[i + free_index] = parse_external_terms(external_term_buf + offset, &term_size, copy, heap, glb);
+                offset += term_size;
+            }
+            *eterm_size = len + 1;
+            return ((term) boxed_func) | TERM_PRIMARY_BOXED;
+        }
+
         default:
             return term_invalid_term();
     }
@@ -1167,6 +1267,47 @@ static int calculate_heap_usage(const uint8_t *external_term_buf, size_t remaini
             return heap_size + u;
         }
 
+        case NEW_FUN_EXT: {
+            if (UNLIKELY(remaining < 30)) {
+                return INVALID_TERM_SIZE;
+            }
+            uint32_t len = READ_32_UNALIGNED(external_term_buf + 1);
+            remaining -= 1;
+            if (UNLIKELY(remaining < len)) {
+                return INVALID_TERM_SIZE;
+            }
+            uint32_t num_free = READ_32_UNALIGNED(external_term_buf + 26);
+            // If module doesn't match or exist, we'll need 3 more for arity, old_index and old_uniq
+            size_t heap_size = BOXED_FUN_SIZE + num_free + 3;
+            int u;
+            if (num_free > 0) {
+                remaining -= 29;
+                size_t offset = 30;
+                size_t term_size;
+                // skip module atom, old index, old uniq, pid
+                for (int i = 0; i < 4; i++) {
+                    u = calculate_heap_usage(external_term_buf + offset, remaining, &term_size, copy);
+                    if (UNLIKELY(u == INVALID_TERM_SIZE)) {
+                        return INVALID_TERM_SIZE;
+                    }
+                    remaining -= term_size;
+                    offset += term_size;
+                }
+                // add free values
+                for (size_t i = 0; i < num_free; i++) {
+                    u = calculate_heap_usage(external_term_buf + offset, remaining, &term_size, copy);
+                    if (UNLIKELY(u == INVALID_TERM_SIZE)) {
+                        return INVALID_TERM_SIZE;
+                    }
+                    heap_size += u;
+                    remaining -= term_size;
+                    offset += term_size;
+                }
+            }
+            *eterm_size = 1 + len;
+            return heap_size;
+        }
+
         default:
             return INVALID_TERM_SIZE;
     }

src/libAtomVM/module.h

@@ -348,6 +348,21 @@ static inline uint32_t module_get_fun_freeze(const Module *this_module, int fun_
     return n_freeze;
 }
 
+static inline void module_get_fun_arity_old_index_uniq(const Module *this_module, int fun_index, uint32_t *arity, uint32_t *index, uint32_t *uniq)
+{
+    const uint8_t *table_data = (const uint8_t *) this_module->fun_table;
+    int funs_count = READ_32_UNALIGNED(table_data + 8);
+
+    assert(fun_index < funs_count);
+
+    // fun atom index
+    *arity = READ_32_UNALIGNED(table_data + fun_index * 24 + 4 + 12);
+    // label
+    *index = READ_32_UNALIGNED(table_data + fun_index * 24 + 12 + 12);
+    // n_freeze
+    *uniq = READ_32_UNALIGNED(table_data + fun_index * 24 + 20 + 12);
+}
+
 static inline void module_get_fun(const Module *this_module, int fun_index, uint32_t *label, uint32_t *arity, uint32_t *n_freeze)
 {
     const uint8_t *table_data = (const uint8_t *) this_module->fun_table;

src/libAtomVM/opcodesswitch.h

@@ -1398,6 +1398,10 @@ static void destroy_extended_registers(Context *ctx, unsigned int live)
             }                                                           \
         }                                                               \
     } else {                                                            \
+        if (term_is_atom(boxed_value[1])) {                             \
+            SET_ERROR(UNDEF_ATOM);                                      \
+            HANDLE_ERROR();                                             \
+        }                                                               \
         fun_module = (Module *) boxed_value[1];                         \
         uint32_t fun_index = term_to_int(index_or_function);            \
         uint32_t fun_arity_and_freeze;                                  \

src/libAtomVM/term.c

@@ -259,13 +259,11 @@ int term_funprint(PrinterFun *fun, term t, const GlobalContext *global)
             atom_index_t module_atom_index = term_to_atom_index(module_name_atom);
             size_t module_name_len;
             const uint8_t *module_name = atom_table_get_atom_string(global->atom_table, module_atom_index, &module_name_len);
-
-            // this is not the same fun_index used on the BEAM, but it should be fine
-            uint32_t fun_index = boxed_value[2];
-
-            // TODO: last component is a uniq, we are temporarly using the memory address
-            int ret = fun->print(fun, "#Fun<%.*s.%" PRIu32 ".%" PRIuPTR ">", (int) module_name_len,
-                module_name, fun_index, (uintptr_t) fun_module);
+            uint32_t fun_index = term_to_int32(boxed_value[2]);
+            uint32_t arity, old_index, old_uniq;
+            module_get_fun_arity_old_index_uniq(fun_module, fun_index, &arity, &old_index, &old_uniq);
+            int ret = fun->print(fun, "#Fun<%.*s.%" PRIu32 ".%" PRIu32 ">", (int) module_name_len,
+                module_name, old_index, old_uniq);
             return ret;
         }
 

tests/erlang_tests/test_binary_to_term.erl

@@ -167,6 +167,7 @@ start() ->
             97, 251, 97, 252, 97, 253, 97, 254, 97, 255, 98, 0, 0, 1, 0>>
     ),
     ok = test_external_function(),
+    ok = test_function(),
 
     {32768, 6} = erlang:binary_to_term(<<131, 98, 0, 0, 128, 0, 127>>, [used]),
     test_catenate_and_split([foo, bar, 128, {foo, bar}, [a, b, c, {d}]]),
@@ -295,6 +296,50 @@ test_external_function() ->
     42 = Fun3(?MODULE, apply, [Fun2, [fun() -> 42 end, []]]),
     ok.
 
+test_function() ->
+    X = id(2),
+    T = [fun(A) -> A * 2 end, fun(A) -> A * X end],
+
+    Bin = erlang:term_to_binary(T),
+
+    <<131, ModuleAtom/binary>> = term_to_binary(?MODULE:id(?MODULE)),
+    ModuleAtomSize = byte_size(ModuleAtom),
+
+    <<131, 108, 2:32, Funs/binary>> = Bin,
+    <<112, Size2:32, Rest1/binary>> = Funs,
+    % need to use split_binary for OTP 21/22
+    {Fun2Bin, <<112, Size3:32, Rest2/binary>>} = split_binary(Rest1, Size2 - 4),
+    {Fun3Bin, <<106>>} = split_binary(Rest2, Size3 - 4),
+    <<1, MD5:16/binary, Index2:32, 0:32, ModuleAtom:ModuleAtomSize/binary, 97, Index2, 98,
+        OldUniq:32, Rest3/binary>> = Fun2Bin,
+    <<1, MD5:16/binary, Index3:32, 1:32, ModuleAtom:ModuleAtomSize/binary, 97, Index3, 98,
+        OldUniq:32, _Rest4/binary>> = Fun3Bin,
+
+    [Fun2, Fun3] = binary_to_term(Bin),
+    true = is_function(Fun2),
+    true = is_function(Fun3),
+    42 = Fun2(21),
+    42 = Fun3(21),
+
+    B1 =
+        <<131, 112, Size2:32, 1, 0:(16 * 8), Index2:32, 0:32, ModuleAtom:ModuleAtomSize/binary, 97,
+            (Index2 bxor 42), 98, (OldUniq bxor 42):32, Rest3/binary>>,
+    Fun4 = binary_to_term(B1),
+    ok =
+        try
+            42 = Fun4(21),
+            unexpected
+        catch
+            error:{badfun, Fun4} ->
+                % BEAM
+                ok;
+            error:undef ->
+                % AtomVM
+                ok
+        end,
+    B1 = term_to_binary(Fun4),
+    ok.
+
 get_binary(Id) ->
     case Id of
         % 'buondì'

tests/erlang_tests/test_fun_to_list.erl

@@ -28,14 +28,14 @@ start() ->
 
     [Id1, LastTok1] = binary:split(Rest1, <<".">>),
     [Uniq1, <<"">>] = binary:split(LastTok1, <<">">>),
-    _ = erlang:binary_to_integer(Id1),
-    _ = erlang:binary_to_integer(Uniq1),
+    0 = erlang:binary_to_integer(Id1),
+    Uniq = erlang:binary_to_integer(Uniq1),
 
     [Id2, LastTok2] = binary:split(Rest2, <<".">>),
     [Uniq2, <<"">>] = binary:split(LastTok2, <<">">>),
 
-    _ = erlang:binary_to_integer(Id2),
-    _ = erlang:binary_to_integer(Uniq2),
+    1 = erlang:binary_to_integer(Id2),
+    Uniq = erlang:binary_to_integer(Uniq2),
 
     <<"fun erlang:integer_to_list/1">> = ?MODULE:fun_to_bin(
         erlang:binary_to_term(erlang:list_to_binary(?MODULE:get_fun_bytes()))