Re: MPS: commit limit

[Helmut Eller <eller.helmut@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 643 bytes --]

On Mon, Jul 08 2024, Gerd Möllmann wrote:
> Sometimes it works just fine, sometimes not. For example, with 1 << 29,
> I get a nice memory full when dumping, always. With 1 << 30, only the
> expensice ert-test triggers something, namely the assertion in MPS.

This patch adds a igc--set-commit-limit function.  It doesn't fix the
problem with the assertion.  People who use the hot MPS build will
probably see a normal memory full error and probably have to quit soon
after that.  The others see the failed assertion and abort immediately.
So the end result will not be much different.

The other two patches are minor cleanups.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-a-igc-set-commit-limit-function.patch --]
[-- Type: text/x-diff, Size: 2905 bytes --]

From 40ea53a3e55ffe414912620484d0bea73af527ef Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 16 Jul 2024 09:54:59 +0200
Subject: [PATCH 1/3] Add a igc--set-commit-limit function

* src/igc (Figc__set_commit_limit): New.
(mps_res_to_string): New helper.
(syms_of_igc): Register it.
* test/src/igc-tests.el (set-commit-limit-test): New.
---
 src/igc.c             | 35 +++++++++++++++++++++++++++++++++++
 test/src/igc-tests.el | 15 +++++++++++++++
 2 files changed, 50 insertions(+)

diff --git a/src/igc.c b/src/igc.c
index a74e62589a2..e29257650a8 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -4316,6 +4316,40 @@ igc_external_header (struct igc_header *h)
   return header_exthdr (h);
 }
 
+static const char *
+mps_res_to_string (mps_res_t res)
+{
+  switch (res)
+    {
+#define RES_CASE(prefix, id, doc)                                            \
+  case prefix##id:                                                           \
+    return #prefix #id " " doc;
+      _mps_RES_ENUM (RES_CASE, MPS_RES_);
+#undef RES_CASE
+    default:
+      return NULL;
+    }
+}
+
+DEFUN ("igc--set-commit-limit", Figc__set_commit_limit,
+       Sigc__set_commit_limit, 1, 1, 0, doc
+       : /* Set the arena commit limit to LIMIT.
+LIMIT can be an integer (number of bytes) or nil (no limit). */)
+(Lisp_Object limit)
+{
+  size_t nbytes
+      = NILP (limit) ? ~0 : check_uinteger_max (limit, SIZE_MAX - 1);
+  mps_res_t err = mps_arena_commit_limit_set (global_igc->arena, nbytes);
+  if (err != MPS_RES_OK)
+    {
+      const char *msg = mps_res_to_string (err);
+      xsignal3 (Qerror,
+		intern_c_string (Sigc__set_commit_limit.s.symbol_name),
+		make_fixnum (err), msg ? build_string (msg) : Qnil);
+    }
+  return Qnil;
+}
+
 static void
 make_arena (struct igc *gc)
 {
@@ -4853,6 +4887,7 @@ syms_of_igc (void)
   defsubr (&Sigc_info);
   defsubr (&Sigc__roots);
   defsubr (&Sigc__collect);
+  defsubr (&Sigc__set_commit_limit);
   defsubr (&Sigc__add_extra_dependency);
   defsubr (&Sigc__remove_extra_dependency);
   DEFSYM (Qambig, "ambig");
diff --git a/test/src/igc-tests.el b/test/src/igc-tests.el
index e69de29bb2d..59a0cb83909 100644
--- a/test/src/igc-tests.el
+++ b/test/src/igc-tests.el
@@ -0,0 +1,15 @@
+;;; igc-tests.el --- tests for src/igc.c -*- lexical-binding: t -*-
+
+(require 'ert)
+
+(ert-deftest set-commit-limit-test ()
+  (should (equal (igc--set-commit-limit (ash 1 30)) nil))
+  (should (equal (assoc-string "commit-limit" (igc-info))
+                 '("commit-limit" 1 1073741824 0)))
+  (should-error (igc--set-commit-limit -1)
+                :type 'args-out-of-range)
+  (should-error (igc--set-commit-limit (- (ash 1 64) 1))
+                :type 'args-out-of-range)
+  (should (equal (igc--set-commit-limit nil) nil))
+  (should (equal (assoc-string "commit-limit" (igc-info))
+                 '("commit-limit" 1 -1 0))))
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Simplify-igc_xpalloc_exact.patch --]
[-- Type: text/x-diff, Size: 6896 bytes --]

From 75fe2bef3d8f6c1866864d2159b6a878c21938d2 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 16 Jul 2024 15:36:52 +0200
Subject: [PATCH 2/3] Simplify igc_xpalloc_exact

Export a igc_fix12_obj function so that the callback stuff isn't needed.

* src/igc.h (igc_fix12_obj): New.
(igc_scan_area_t, igc_xpalloc_exact): Simplify.
(struct igc_ss): Renamed from igc_opaque;
* src/igc.c (igc_fix12_obj): Rename dfrom fix12_obj_callback.
(scan_xpalloced): Deleted.
(igc_xpalloc_exact): Simplify.
* src/print.c (scan_ppstack, scan_prstack): Use igc_fix12_obj.
---
 src/igc.c   | 26 ++++++++------------------
 src/igc.h   | 15 +++++++--------
 src/print.c | 26 +++++++++++++-------------
 3 files changed, 28 insertions(+), 39 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index e29257650a8..51fc7f26917 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2538,14 +2538,11 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
   return MPS_RES_OK;
 }
 
-static igc_scan_result_t
-fix12_obj_callback (struct igc_opaque *op, Lisp_Object *addr)
+igc_scan_result_t
+igc_fix12_obj (struct igc_ss *ssp, Lisp_Object *addr)
 {
-  mps_ss_t ss = (mps_ss_t) op;
-  MPS_SCAN_BEGIN (ss)
-  {
-    IGC_FIX12_OBJ (ss, addr);
-  }
+  mps_ss_t ss = (mps_ss_t)ssp;
+  MPS_SCAN_BEGIN (ss) { IGC_FIX12_OBJ (ss, addr); }
   MPS_SCAN_END (ss);
   return MPS_RES_OK;
 }
@@ -3007,18 +3004,11 @@ igc_xpalloc_ambig (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
   return pa;
 }
 
-static mps_res_t
-scan_xpalloced (mps_ss_t ss, void *start, void *end, void *closure)
-{
-  igc_scan_area_t scan_area = closure;
-  igc_fix12_obj_t fix12_obj = (igc_fix12_obj_t) fix12_obj_callback;
-  return scan_area ((struct igc_opaque *) ss, start, end, fix12_obj);
-}
-
 void
 igc_xpalloc_exact (void **pa_cell, ptrdiff_t *nitems,
 		   ptrdiff_t nitems_incr_min, ptrdiff_t nitems_max,
-		   ptrdiff_t item_size, igc_scan_area_t scan_area)
+		   ptrdiff_t item_size, igc_scan_area_t scan_area,
+		   void *closure)
 {
   IGC_WITH_PARKED (global_igc)
   {
@@ -3026,8 +3016,8 @@ igc_xpalloc_exact (void **pa_cell, ptrdiff_t *nitems,
     destroy_root_with_start (pa);
     pa = xpalloc (pa, nitems, nitems_incr_min, nitems_max, item_size);
     char *end = (char *)pa + *nitems * item_size;
-    root_create (global_igc, pa, end, mps_rank_exact (),
-		 scan_xpalloced, scan_area, false, "xpalloc-exact");
+    root_create (global_igc, pa, end, mps_rank_exact (), scan_area, closure,
+		 false, "xpalloc-exact");
     *pa_cell = pa;
   }
 }
diff --git a/src/igc.h b/src/igc.h
index 1041252bd10..3b750fe0453 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -96,16 +96,15 @@ #define EMACS_IGC_H
 			 ptrdiff_t nitems_incr_min, ptrdiff_t nitems_max,
 			 ptrdiff_t item_size);
 
-typedef uintptr_t igc_scan_result_t; /* zero means success */
-struct igc_opaque;
-typedef igc_scan_result_t (*igc_fix12_obj_t) (struct igc_opaque *,
-					      Lisp_Object *addr);
-typedef igc_scan_result_t (*igc_scan_area_t) (struct igc_opaque *,
-					      void *start, void *end,
-					      igc_fix12_obj_t fun);
+typedef int igc_scan_result_t; /* zero means success */
+struct igc_ss;
+typedef igc_scan_result_t (*igc_scan_area_t) (struct igc_ss *ss, void *start,
+					      void *end, void *closure);
+igc_scan_result_t igc_fix12_obj (struct igc_ss *ss, Lisp_Object *addr);
 void igc_xpalloc_exact (void **pa_cell, ptrdiff_t *nitems,
 			ptrdiff_t nitems_incr_min, ptrdiff_t nitems_max,
-			ptrdiff_t item_size, igc_scan_area_t scan);
+			ptrdiff_t item_size, igc_scan_area_t scan,
+			void *closure);
 
 void *igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size);
 
diff --git a/src/print.c b/src/print.c
index 512679e0ed4..2016e46728e 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1337,11 +1337,11 @@ #define PRINT_CIRCLE_CANDIDATE_P(obj)			   \
 
 #ifdef HAVE_MPS
 static igc_scan_result_t
-scan_ppstack (struct igc_opaque *op, void *start, void *end,
-	      igc_fix12_obj_t fix12_obj)
+scan_ppstack (struct igc_ss *ss, void *start, void *end, void *closure)
 {
   eassert (start == (void *)ppstack.stack);
   eassert (end == (void *)(ppstack.stack + ppstack.size));
+  eassert (closure == NULL);
   for (struct print_pp_entry *p = start; (void *) p < end; ++p)
     {
       if (p->is_free)
@@ -1349,13 +1349,13 @@ scan_ppstack (struct igc_opaque *op, void *start, void *end,
       igc_scan_result_t err = 0;
       if (p->n == 0)
 	{
-	  if (err = fix12_obj (op, &p->u.value), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.value), err != 0)
 	    return err;
 	}
       else
 	{
 	  eassert (p->n > 0);
-	  if (err = fix12_obj (op, &p->u.vectorlike), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.vectorlike), err != 0)
 	    return err;
 	}
     }
@@ -1371,7 +1371,7 @@ grow_pp_stack (void)
 #ifdef HAVE_MPS
   ptrdiff_t old_size = ps->size;
   igc_xpalloc_exact ((void **) &ppstack.stack, &ps->size, 1, -1,
-		     sizeof *ps->stack, scan_ppstack);
+		     sizeof *ps->stack, scan_ppstack, NULL);
   for (ptrdiff_t i = old_size; i < ps->size; ++i)
     ppstack.stack[i].is_free = true;
 #else
@@ -2286,12 +2286,12 @@ named_escape (int i)
 
 #ifdef HAVE_MPS
 static igc_scan_result_t
-scan_prstack (struct igc_opaque *op, void *start, void *end,
-	      igc_fix12_obj_t fix12_obj)
+scan_prstack (struct igc_ss *ss, void *start, void *end, void *closure)
 {
   eassert (start == (void *)prstack.stack);
   eassert (end == (void *)(prstack.stack + prstack.size));
-  for (struct print_stack_entry *p = start; (void *) p < end; p++)
+  eassert (closure == NULL);
+  for (struct print_stack_entry *p = start; (void *)p < end; p++)
     {
       igc_scan_result_t err = 0;
       if (p->type == PE_free)
@@ -2302,9 +2302,9 @@ scan_prstack (struct igc_opaque *op, void *start, void *end,
 	  emacs_abort ();
 
 	case PE_list:
-	  if (err = fix12_obj (op, &p->u.list.last), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.list.last), err != 0)
 	    return err;
-	  if (err = fix12_obj (op, &p->u.list.tortoise), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.list.tortoise), err != 0)
 	    return err;
 	  break;
 
@@ -2312,12 +2312,12 @@ scan_prstack (struct igc_opaque *op, void *start, void *end,
 	  break;
 
 	case PE_vector:
-	  if (err = fix12_obj (op, &p->u.vector.obj), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.vector.obj), err != 0)
 	    return err;
 	  break;
 
 	case PE_hash:
-	  if (err = fix12_obj (op, &p->u.hash.obj), err != 0)
+	  if (err = igc_fix12_obj (ss, &p->u.hash.obj), err != 0)
 	    return err;
 	  break;
 	}
@@ -2334,7 +2334,7 @@ grow_print_stack (void)
 #ifdef HAVE_MPS
   ptrdiff_t old_size = ps->size;
   igc_xpalloc_exact ((void **) &prstack.stack, &ps->size, 1, -1,
-		     sizeof *ps->stack, scan_prstack);
+		     sizeof *ps->stack, scan_prstack, NULL);
   for (ptrdiff_t i = old_size; i < ps->size; ++i)
     ps->stack[i].type = PE_free;
 #else
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Always-typecheck-igc_assertions.patch --]
[-- Type: text/x-diff, Size: 1292 bytes --]

From f60ac0667860d4ff4c529d99d9f60c6a346c643c Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 16 Jul 2024 16:58:18 +0200
Subject: [PATCH 3/3] Always typecheck igc_assertions

* src/igc.c (igc_assert) [!IGC_DEBUG]: Typecheck the expression even if
it is always true.
(set_state, weak_vector_p): Remove some ifdefs.
---
 src/igc.c | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 51fc7f26917..2cdf884f4ee 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -218,7 +218,7 @@ igc_assert_fail (const char *file, unsigned line, const char *msg)
     }							\
   while (0)
 #else
-# define igc_assert(expr) (void) 0
+# define igc_assert(expr) ((void) (true || (expr)))
 #endif
 
 #define IGC_NOT_IMPLEMENTED() \
@@ -814,9 +814,7 @@ arena_release (struct igc *gc)
 static void
 set_state (enum igc_state state)
 {
-#ifdef IGC_DEBUG
   enum igc_state old_state = igc_state;
-#endif
   igc_state = state;
   switch (igc_state)
     {
@@ -4171,7 +4169,6 @@ igc_remove_all_markers (struct buffer *b)
     }
 }
 
-#ifdef IGC_DEBUG
 static bool
 weak_vector_p (Lisp_Object x)
 {
@@ -4186,7 +4183,6 @@ weak_vector_p (Lisp_Object x)
   else
     return false;
 }
-#endif
 
 void
 igc_resurrect_markers (struct buffer *b)
-- 
2.39.2