[PATCH] libpoke: Use uncollectable memory instead of GC roots

[Mohammad-Reza Nabipoor]

The AST uses reference counting in order to manage the memory, but
PVM values are managed by the GC. The problem arises when the AST
needs to save some PVM values (the closures for array and struct
types). The GC usually doesn't consider the references from objects
allocated with the system malloc, so we should somehow tell the GC
that there are references to the PVM values. This has been done using
`pvm_alloc_{add,remove}_gc_roots` functions. But we cannot have too
many roots in the GC. So with this commit we change the approch to save
the PVM values in uncollectable memory returned by
`GC_MALLOC_UNCOLLECTABLE`. Objects allocated in this way are effectively
treated as roots by the collector.

2021-04-22  Mohammad-Reza Nabipoor  <m.nabipoor@yahoo.com>

        * libpoke/pvm-alloc.h (pvm_alloc_uncollectable): New function decl.
        (pvm_free_uncollectable): Likewise.
        * libpoke/pvm-alloc.c (pvm_alloc_uncollectable): New function def.
        (pvm_free_uncollectable): Likewise.
        * libpoke/pkl-ast.h (struct pkl_ast_type): For both arrays and
        structs, replace the PVM closure fields with pointer to `pvm_val`.
        (PKL_AST_TYPE_A_CLOSURES): Re-define accordingly.
        (PKL_AST_TYPE_A_MAPPER): Likewise.
        (PKL_AST_TYPE_A_WRITER): Likewise.
        (PKL_AST_TYPE_A_BOUNDER): Likewise.
        (PKL_AST_TYPE_A_CONSTRUCTOR): Likewise.
        (PKL_AST_TYPE_A_PRINTER): Likewise.
        (PKL_AST_TYPE_S_CLOSURES): Likewise.
        (PKL_AST_TYPE_S_MAPPER): Likewise.
        (PKL_AST_TYPE_S_WRITER): Likewise.
        (PKL_AST_TYPE_S_CONSTRUCTOR): Likewise.
        (PKL_AST_TYPE_S_PRINTER): Likewise.
        (PKL_AST_TYPE_S_COMPARATOR): Likewise.
        (PKL_AST_TYPE_S_INTEGRATOR): Likewise.
        * libpoke/pkl-ast.c (pkl_ast_make_array_type): Initialize the
        `closures` field with a pointer to uncollectable memory. Remove
        the `pvm_alloc_add_gc_roots` function calls.
        (pkl_ast_make_struct_type): Likewise.
        (pkl_ast_node_free): Free the uncollectable memory for arrays and
        structs.
---


Hi, Jose.

The comments from `gc/gc.h`:

/* new object is cleared.  GC_malloc_uncollectable allocates            */
/* an object that is scanned for pointers to collectible                */
/* objects, but is not itself collectible.  The object is scanned even  */
/* if it does not appear to be reachable.  GC_malloc_uncollectable and  */
/* GC_free called on the resulting object implicitly update             */
/* GC_non_gc_bytes appropriately.                                       */


And also this paragraph from https://www.hboehm.info/gc/gcinterface.html:

  Identical to GC_MALLOC, except that the resulting object is not
  automatically deallocated. Unlike the system-provided malloc, the
  collector does scan the object for pointers to garbage-collectable
  memory, even if the block itself does not appear to be reachable.
  (Objects allocated in this way are effectively treated as roots by
  the collector.) 


Georgiy Tugai (SAL9000) was correct!


The other approach is to `pvm_alloc_uncollectable` each field separately,
but I think the current approach is better.
WDYT?


Regards,
Mohammad-Reza


 ChangeLog           | 28 ++++++++++++++++++++++++++++
 libpoke/pkl-ast.c   | 42 +++++++++++++-----------------------------
 libpoke/pkl-ast.h   | 41 +++++++++++++++++++----------------------
 libpoke/pvm-alloc.c | 11 +++++++++++
 libpoke/pvm-alloc.h | 13 +++++++++++++
 5 files changed, 84 insertions(+), 51 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 9acad95b..f41839a7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,31 @@
+2021-04-22  Mohammad-Reza Nabipoor  <m.nabipoor@yahoo.com>
+
+       * libpoke/pvm-alloc.h (pvm_alloc_uncollectable): New function decl.
+       (pvm_free_uncollectable): Likewise.
+       * libpoke/pvm-alloc.c (pvm_alloc_uncollectable): New function def.
+       (pvm_free_uncollectable): Likewise.
+       * libpoke/pkl-ast.h (struct pkl_ast_type): For both arrays and
+       structs, replace the PVM closure fields with pointer to `pvm_val`.
+       (PKL_AST_TYPE_A_CLOSURES): Re-define accordingly.
+       (PKL_AST_TYPE_A_MAPPER): Likewise.
+       (PKL_AST_TYPE_A_WRITER): Likewise.
+       (PKL_AST_TYPE_A_BOUNDER): Likewise.
+       (PKL_AST_TYPE_A_CONSTRUCTOR): Likewise.
+       (PKL_AST_TYPE_A_PRINTER): Likewise.
+       (PKL_AST_TYPE_S_CLOSURES): Likewise.
+       (PKL_AST_TYPE_S_MAPPER): Likewise.
+       (PKL_AST_TYPE_S_WRITER): Likewise.
+       (PKL_AST_TYPE_S_CONSTRUCTOR): Likewise.
+       (PKL_AST_TYPE_S_PRINTER): Likewise.
+       (PKL_AST_TYPE_S_COMPARATOR): Likewise.
+       (PKL_AST_TYPE_S_INTEGRATOR): Likewise.
+       * libpoke/pkl-ast.c (pkl_ast_make_array_type): Initialize the
+       `closures` field with a pointer to uncollectable memory. Remove
+       the `pvm_alloc_add_gc_roots` function calls.
+       (pkl_ast_make_struct_type): Likewise.
+       (pkl_ast_node_free): Free the uncollectable memory for arrays and
+       structs.
+
 2021-04-18  Jose E. Marchesi  <jemarch@gnu.org>
 
        * configure.ac: Bump poke version to 1.2.
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index eb7f4ee6..5c08b65b 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -27,7 +27,7 @@
 #include "xalloc.h"
 
 #include "pvm.h"
-#include "pvm-alloc.h" /* For pvm_alloc_{add/remove}_gc_roots */
+#include "pvm-alloc.h" /* For pvm_{alloc,free}_uncollectable.  */
 #include "pk-utils.h"
 #include "pkl-ast.h"
 
@@ -370,6 +370,7 @@ pkl_ast_node
 pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype, pkl_ast_node bound)
 {
   pkl_ast_node type = pkl_ast_make_type (ast);
+  const int nclosures = 5; /* mapper, writer, bounder, constructor, printer */
 
   assert (etype);
 
@@ -378,19 +379,15 @@ pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype, 
pkl_ast_node bound)
   if (bound)
     PKL_AST_TYPE_A_BOUND (type) = ASTREF (bound);
 
+  /* Prevent GC to collect these PVM values.  */
+  PKL_AST_TYPE_A_CLOSURES (type)
+      = pvm_alloc_uncollectable (nclosures * sizeof (pvm_val));
   PKL_AST_TYPE_A_MAPPER (type) = PVM_NULL;
   PKL_AST_TYPE_A_WRITER (type) = PVM_NULL;
   PKL_AST_TYPE_A_BOUNDER (type) = PVM_NULL;
   PKL_AST_TYPE_A_CONSTRUCTOR (type) = PVM_NULL;
   PKL_AST_TYPE_A_PRINTER (type) = PVM_NULL;
 
-  /* The closure slots are GC roots.  */
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_MAPPER (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_WRITER (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_BOUNDER (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_CONSTRUCTOR (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_A_PRINTER (type), 1);
-
   return type;
 }
 
@@ -444,6 +441,8 @@ pkl_ast_make_struct_type (pkl_ast ast,
                           int pinned_p, int union_p)
 {
   pkl_ast_node type = pkl_ast_make_type (ast);
+  const int nclosures
+      = 6; /* writer, mapper, constructor, comparator, integrator, printer.  */
 
   PKL_AST_TYPE_CODE (type) = PKL_TYPE_STRUCT;
   PKL_AST_TYPE_S_NELEM (type) = nelem;
@@ -455,6 +454,10 @@ pkl_ast_make_struct_type (pkl_ast ast,
     PKL_AST_TYPE_S_ITYPE (type) = ASTREF (itype);
   PKL_AST_TYPE_S_PINNED_P (type) = pinned_p;
   PKL_AST_TYPE_S_UNION_P (type) = union_p;
+
+  /* Prevent GC to collect these PVM values.  */
+  PKL_AST_TYPE_S_CLOSURES (type)
+      = pvm_alloc_uncollectable (nclosures * sizeof (pvm_val));
   PKL_AST_TYPE_S_MAPPER (type) = PVM_NULL;
   PKL_AST_TYPE_S_WRITER (type) = PVM_NULL;
   PKL_AST_TYPE_S_CONSTRUCTOR (type) = PVM_NULL;
@@ -462,14 +465,6 @@ pkl_ast_make_struct_type (pkl_ast ast,
   PKL_AST_TYPE_S_INTEGRATOR (type) = PVM_NULL;
   PKL_AST_TYPE_S_PRINTER (type) = PVM_NULL;
 
-  /* The closure slots are GC roots.  */
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_WRITER (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_MAPPER (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_CONSTRUCTOR (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_COMPARATOR (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_INTEGRATOR (type), 1);
-  pvm_alloc_add_gc_roots (&PKL_AST_TYPE_S_PRINTER (type), 1);
-
   return type;
 }
 
@@ -1987,24 +1982,13 @@ pkl_ast_node_free (pkl_ast_node ast)
       switch (PKL_AST_TYPE_CODE (ast))
         {
         case PKL_TYPE_ARRAY:
-          /* Remove GC roots.  */
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_MAPPER (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_WRITER (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_BOUNDER (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_CONSTRUCTOR (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_A_PRINTER (ast), 1);
+          pvm_free_uncollectable (PKL_AST_TYPE_A_CLOSURES (ast));
 
           pkl_ast_node_free (PKL_AST_TYPE_A_BOUND (ast));
           pkl_ast_node_free (PKL_AST_TYPE_A_ETYPE (ast));
           break;
         case PKL_TYPE_STRUCT:
-          /* Remove GC roots.  */
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_WRITER (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_MAPPER (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_CONSTRUCTOR (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_COMPARATOR (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_INTEGRATOR (ast), 1);
-          pvm_alloc_remove_gc_roots (&PKL_AST_TYPE_S_PRINTER (ast), 1);
+          pvm_free_uncollectable (PKL_AST_TYPE_S_CLOSURES (ast));
 
           for (t = PKL_AST_TYPE_S_ELEMS (ast); t; t = n)
             {
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index 4d9e18cc..803e34f8 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -892,23 +892,25 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
 #define PKL_AST_TYPE_I_SIGNED_P(AST) ((AST)->type.val.integral.signed_p)
 #define PKL_AST_TYPE_A_BOUND(AST) ((AST)->type.val.array.bound)
 #define PKL_AST_TYPE_A_ETYPE(AST) ((AST)->type.val.array.etype)
-#define PKL_AST_TYPE_A_MAPPER(AST) ((AST)->type.val.array.mapper)
-#define PKL_AST_TYPE_A_WRITER(AST) ((AST)->type.val.array.writer)
-#define PKL_AST_TYPE_A_BOUNDER(AST) ((AST)->type.val.array.bounder)
-#define PKL_AST_TYPE_A_CONSTRUCTOR(AST) ((AST)->type.val.array.constructor)
-#define PKL_AST_TYPE_A_PRINTER(AST) ((AST)->type.val.array.printer)
+#define PKL_AST_TYPE_A_CLOSURES(AST) ((AST)->type.val.array.closures)
+#define PKL_AST_TYPE_A_MAPPER(AST) ((AST)->type.val.array.closures[0])
+#define PKL_AST_TYPE_A_WRITER(AST) ((AST)->type.val.array.closures[1])
+#define PKL_AST_TYPE_A_BOUNDER(AST) ((AST)->type.val.array.closures[2])
+#define PKL_AST_TYPE_A_CONSTRUCTOR(AST) ((AST)->type.val.array.closures[3])
+#define PKL_AST_TYPE_A_PRINTER(AST) ((AST)->type.val.array.closures[4])
 #define PKL_AST_TYPE_S_NFIELD(AST) ((AST)->type.val.sct.nfield)
 #define PKL_AST_TYPE_S_NDECL(AST) ((AST)->type.val.sct.ndecl)
 #define PKL_AST_TYPE_S_NELEM(AST) ((AST)->type.val.sct.nelem)
 #define PKL_AST_TYPE_S_ELEMS(AST) ((AST)->type.val.sct.elems)
 #define PKL_AST_TYPE_S_PINNED_P(AST) ((AST)->type.val.sct.pinned_p)
 #define PKL_AST_TYPE_S_UNION_P(AST) ((AST)->type.val.sct.union_p)
-#define PKL_AST_TYPE_S_MAPPER(AST) ((AST)->type.val.sct.mapper)
-#define PKL_AST_TYPE_S_WRITER(AST) ((AST)->type.val.sct.writer)
-#define PKL_AST_TYPE_S_CONSTRUCTOR(AST) ((AST)->type.val.sct.constructor)
-#define PKL_AST_TYPE_S_PRINTER(AST) ((AST)->type.val.sct.printer)
-#define PKL_AST_TYPE_S_COMPARATOR(AST) ((AST)->type.val.sct.comparator)
-#define PKL_AST_TYPE_S_INTEGRATOR(AST) ((AST)->type.val.sct.integrator)
+#define PKL_AST_TYPE_S_CLOSURES(AST) ((AST)->type.val.sct.closures)
+#define PKL_AST_TYPE_S_MAPPER(AST) ((AST)->type.val.sct.closures[0])
+#define PKL_AST_TYPE_S_WRITER(AST) ((AST)->type.val.sct.closures[1])
+#define PKL_AST_TYPE_S_CONSTRUCTOR(AST) ((AST)->type.val.sct.closures[2])
+#define PKL_AST_TYPE_S_PRINTER(AST) ((AST)->type.val.sct.closures[3])
+#define PKL_AST_TYPE_S_COMPARATOR(AST) ((AST)->type.val.sct.closures[4])
+#define PKL_AST_TYPE_S_INTEGRATOR(AST) ((AST)->type.val.sct.closures[5])
 #define PKL_AST_TYPE_S_ITYPE(AST) ((AST)->type.val.sct.itype)
 #define PKL_AST_TYPE_O_UNIT(AST) ((AST)->type.val.off.unit)
 #define PKL_AST_TYPE_O_BASE_TYPE(AST) ((AST)->type.val.off.base_type)
@@ -943,11 +945,9 @@ struct pkl_ast_type
     {
       union pkl_ast_node *bound;
       union pkl_ast_node *etype;
-      pvm_val mapper;
-      pvm_val writer;
-      pvm_val bounder;
-      pvm_val constructor;
-      pvm_val printer;
+      /* Uncollectable array for MAPPER, BOUNDER, WRITER, CONSTRUCTOR
+         and PRINTER.  */
+      pvm_val *closures;
     } array;
 
     struct
@@ -959,12 +959,9 @@ struct pkl_ast_type
       union pkl_ast_node *itype;
       int pinned_p;
       int union_p;
-      pvm_val mapper;
-      pvm_val writer;
-      pvm_val constructor;
-      pvm_val comparator;
-      pvm_val integrator;
-      pvm_val printer;
+      /* Uncollectable array for MAPPER, WRITER, CONSTRUCTOR, COMPARATOR,
+         INTEGRATOR and PRINTER.  */
+      pvm_val *closures;
     } sct;
 
     struct
diff --git a/libpoke/pvm-alloc.c b/libpoke/pvm-alloc.c
index ab7bc9d3..6a14b102 100644
--- a/libpoke/pvm-alloc.c
+++ b/libpoke/pvm-alloc.c
@@ -28,6 +28,17 @@ pvm_alloc (size_t size)
   return GC_MALLOC (size);
 }
 
+void *
+pvm_alloc_uncollectable (size_t size)
+{
+  return GC_MALLOC_UNCOLLECTABLE (size);
+}
+
+void pvm_free_uncollectable (void *ptr)
+{
+  GC_FREE (ptr);
+}
+
 void *
 pvm_realloc (void *ptr, size_t size)
 {
diff --git a/libpoke/pvm-alloc.h b/libpoke/pvm-alloc.h
index 291b6eb1..15e09b40 100644
--- a/libpoke/pvm-alloc.h
+++ b/libpoke/pvm-alloc.h
@@ -46,6 +46,19 @@ void *pvm_alloc (size_t size)
   __attribute__ ((malloc))
   __attribute__ ((alloc_size (1)));
 
+
+/* Allocate SIZE bytes and return a pointer to the allocated memory.
+   SIZE has the same semantics as in malloc(3).  This function is
+   identical to pvm_alloc, except that the resulting object is not
+   automatically deallocated.  On error, return NULL.  */
+
+void *pvm_alloc_uncollectable (size_t size)
+  __attribute__ ((malloc))
+  __attribute__ ((alloc_size (1)));
+
+void pvm_free_uncollectable (void *ptr);
+
+
 /* Reallocate the given pointer to occupy SIZE bytes and return a
    pointer to the allocated memory.  SIZE has the same semantics as in
    realloc(3).  On error, return NULL.  */
-- 
2.31.1