unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* MPS prstack
@ 2024-05-20 17:54 Helmut Eller
  2024-05-20 18:21 ` Gerd Möllmann
  2024-05-22 16:27 ` Helmut Eller
  0 siblings, 2 replies; 22+ messages in thread
From: Helmut Eller @ 2024-05-20 17:54 UTC (permalink / raw)
  To: Gerd Möllmann; +Cc: Eli Zaretskii, Emacs Devel

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

In print.c, there is a global variable prstack that is not yet scanned.
This causes a crash for comp-tests but this example triggers the same
problem:

(progn
  (defun make-tree (i)
    (cond ((= i 0) nil)
	  (t (list (make-string 10000 i)
		   (make-tree (1- i)) (make-tree (1- i))))))
  (prin1-to-string (make-tree 13)))

We could create an ambiguous root for this but I thought it would be an
interesting exercise to scan it exactly.  It's interesting because this is
a static variable and the type is only declared in print.c.  So I added
a new function igc_xpalloc_exact to igc.h.  That uses a callback that
calls another callback.  I'm not sure if this allowed by the MPS rules
but it seems to work or at least doesn't seem to crash.

WDYT?


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

From 925a4b0daeef769e6048b068a7c35674000797db Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 20 May 2024 17:44:34 +0200
Subject: [PATCH 1/2] Add a igc_xpalloc_exact function

* src/igc.h (igc_xpalloc_exact): New.
(igc_scan_result_t, igc_opaque, igc_scan_cell_t, igc_scan_area_t): New
auxilarry types.
* src/igc.c (igc_xpalloc_exact): Implement it.
(scan_xpalloced, scan_cell_callback): New helpers.
(root_create): Allow a closure argument.
(root_create_ambig, root_create_exact, root_create_igc)
(root_create_pure): Set the closure argument to NULL.
---
 src/igc.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++-------
 src/igc.h | 18 +++++++++++++++--
 2 files changed, 67 insertions(+), 9 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index 5e0e2e8fdd2..e2e9af97f94 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2001,15 +2001,28 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
   return MPS_RES_OK;
 }
 
+static igc_scan_result_t
+scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr)
+{
+  mps_ss_t ss = (mps_ss_t)op;
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_OBJ (ss, addr);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 #pragma GCC diagnostic pop
 
 static igc_root_list *
 root_create (struct igc *gc, void *start, void *end, mps_rank_t rank,
-	     mps_area_scan_t scan, bool ambig)
+	     mps_area_scan_t scan, void *closure, bool ambig)
 {
   mps_root_t root;
   mps_res_t res
-    = mps_root_create_area (&root, gc->arena, rank, 0, start, end, scan, 0);
+    = mps_root_create_area (&root, gc->arena, rank, 0, start, end, scan,
+			    closure);
   IGC_CHECK_RES (res);
   return register_root (gc, root, start, end, ambig);
 }
@@ -2017,13 +2030,15 @@ root_create (struct igc *gc, void *start, void *end, mps_rank_t rank,
 static igc_root_list *
 root_create_ambig (struct igc *gc, void *start, void *end)
 {
-  return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, true);
+  return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, NULL,
+		      true);
 }
 
 static igc_root_list *
-root_create_exact (struct igc *gc, void *start, void *end, mps_area_scan_t scan)
+root_create_exact (struct igc *gc, void *start, void *end,
+		   mps_area_scan_t scan)
 {
-  return root_create (gc, start, end, mps_rank_exact (), scan, false);
+  return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false);
 }
 
 static void
@@ -2115,7 +2130,7 @@ root_create_bc (struct igc_thread_list *t)
 static void
 root_create_igc (struct igc *gc)
 {
-  root_create (gc, gc, gc + 1, mps_rank_exact (), scan_igc, false);
+  root_create (gc, gc, gc + 1, mps_rank_exact (), scan_igc, NULL, false);
 }
 
 #ifndef IN_MY_FORK
@@ -2124,7 +2139,7 @@ root_create_pure (struct igc *gc)
 {
   void *start = &pure[0];
   void *end = &pure[PURESIZE];
-  root_create (gc, start, end, mps_rank_ambig (), scan_pure, true);
+  root_create (gc, start, end, mps_rank_ambig (), scan_pure, NULL, true);
 }
 #endif
 
@@ -2355,6 +2370,35 @@ 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_scan_cell_t scan_cell = (igc_scan_cell_t)scan_cell_callback;
+  return scan_area ((struct igc_opaque *)ss, start, end, scan_cell);
+}
+
+void *
+igc_xpalloc_exact (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
+		   ptrdiff_t nitems_max, ptrdiff_t item_size,
+		   igc_scan_area_t scan_area)
+{
+  IGC_WITH_PARKED (global_igc)
+  {
+    if (pa)
+      {
+	struct igc_root_list *r = root_find (pa);
+	igc_assert (r != NULL);
+	destroy_root (&r);
+      }
+    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);
+  }
+  return pa;
+}
+
 void *
 igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
 {
diff --git a/src/igc.h b/src/igc.h
index 2fe134bc2d7..384d5acdf1b 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -72,8 +72,22 @@ #define EMACS_IGC_H
 void *igc_realloc_ambig (void *block, size_t size);
 void igc_xfree (void *p);
 Lisp_Object *igc_xalloc_lisp_objs_exact (size_t n);
-void *igc_xpalloc_ambig (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
-		   ptrdiff_t nitems_max, ptrdiff_t item_size);
+
+void *igc_xpalloc_ambig (void *pa, ptrdiff_t *nitems,
+			 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_scan_cell_t) (struct igc_opaque *,
+					      Lisp_Object *addr);
+typedef igc_scan_result_t (*igc_scan_area_t) (struct igc_opaque *,
+					      void *start, void *end,
+					      igc_scan_cell_t fun);
+void *igc_xpalloc_exact (void *pa, ptrdiff_t *nitems,
+			 ptrdiff_t nitems_incr_min, ptrdiff_t nitems_max,
+			 ptrdiff_t item_size, igc_scan_area_t scan);
+
 void *igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size);
 
 struct Lisp_Vector *igc_alloc_pseudovector (size_t nwords_mem,
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Allocate-prstack-as-exact-root.patch --]
[-- Type: text/x-diff, Size: 1862 bytes --]

From 928270d0f7ad2200fb3b5a6f126fd43c7740bbe3 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Mon, 20 May 2024 17:49:29 +0200
Subject: [PATCH 2/2] Allocate prstack as exact root

* src/print.c (grow_print_stack): Use igc_xpalloc_exact.
(scan_prstack): New.
---
 src/print.c | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/src/print.c b/src/print.c
index 440c1c0e575..f043da92c1f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2200,12 +2200,52 @@ named_escape (int i)
 
 static struct print_stack prstack = {NULL, 0, 0};
 
+static igc_scan_result_t
+scan_prstack (struct igc_opaque *op, void *start, void *end,
+	      igc_scan_cell_t scan1)
+{
+  eassert (start == (void *)prstack.stack);
+  eassert (end == (void *)(prstack.stack + prstack.size));
+  struct print_stack_entry *p = start;
+  struct print_stack_entry *q = p + prstack.sp;
+  for (; p < q; p++)
+    {
+      igc_scan_result_t err = 0;
+      switch (p->type)
+	{
+	case PE_list:
+	  if (err = scan1 (op, &p->u.list.last), err != 0)
+	    return err;
+	  if (err = scan1 (op, &p->u.list.tortoise), err != 0)
+	    return err;
+	  continue;
+	case PE_rbrac:
+	  continue;
+	case PE_vector:
+	  if (err = scan1 (op, &p->u.vector.obj), err != 0)
+	    return err;
+	  continue;
+	case PE_hash:
+	  if (err = scan1 (op, &p->u.hash.obj), err != 0)
+	    return err;
+	  continue;
+	}
+      eassert (!"not yet implemented");
+    }
+  return 0;
+}
+
 NO_INLINE static void
 grow_print_stack (void)
 {
   struct print_stack *ps = &prstack;
   eassert (ps->sp == ps->size);
+#ifdef HAVE_MPS
+  ps->stack = igc_xpalloc_exact (ps->stack, &ps->size, 1, -1,
+				 sizeof *ps->stack, scan_prstack);
+#else
   ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack);
+#endif
   eassert (ps->sp < ps->size);
 }
 
-- 
2.39.2


^ permalink raw reply related	[flat|nested] 22+ messages in thread

end of thread, other threads:[~2024-05-27 15:08 UTC | newest]

Thread overview: 22+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-05-20 17:54 MPS prstack Helmut Eller
2024-05-20 18:21 ` Gerd Möllmann
2024-05-20 18:32   ` Helmut Eller
2024-05-21  3:30     ` Gerd Möllmann
2024-05-22 16:27 ` Helmut Eller
2024-05-22 17:55   ` Gerd Möllmann
2024-05-24 14:17   ` Helmut Eller
2024-05-24 14:27     ` Gerd Möllmann
2024-05-25 13:45       ` Gerd Möllmann
2024-05-27  7:27         ` Helmut Eller
2024-05-27  8:43           ` Gerd Möllmann
2024-05-27  9:15             ` Helmut Eller
2024-05-27  9:47               ` Gerd Möllmann
2024-05-27 11:45               ` Eli Zaretskii
2024-05-27 12:39                 ` Helmut Eller
2024-05-27 13:12                   ` Eli Zaretskii
2024-05-27 14:15                     ` Helmut Eller
2024-05-27 14:37                       ` Mattias Engdegård
2024-05-27 14:54                         ` Helmut Eller
2024-05-27 14:43                       ` Po Lu
2024-05-27 15:08                         ` Helmut Eller
2024-05-27 11:34           ` Eli Zaretskii

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).