MPS prstack

MPS prstack

[Helmut Eller]

[-- 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

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> 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?

LGTM and pushed. Thanks!

AFAICT, taking the reference literally, it is permissible to pass the
mps_ss_t around. It merely says this

  type mps_ss_t
  The type of scan states.

  A scan state represents the state of the current scan. The MPS passes
  a scan state to the scan method of an object format when it needs to
  scan for references within a region of memory. The scan method must
  pass the scan state to MPS_SCAN_BEGIN and MPS_SCAN_END to delimit a
  sequence of fix operations, and to the functions MPS_FIX1(),
  MPS_FIX2() and MPS_FIX12() when fixing a reference.

And that we do...
And it doesn't crash :-)

I've BTW also protected all the user-defined hash test functions in some
commit today, which are malloc'd in fns.c. Reason is that these persist
beyond the lifetime of hash tables using them, IIUC. Strange thing,
somewhat. Whatever :-).

Re: MPS prstack

[Helmut Eller]

On Mon, May 20 2024, Gerd Möllmann wrote:

> I've BTW also protected all the user-defined hash test functions in some
> commit today, which are malloc'd in fns.c. Reason is that these persist
> beyond the lifetime of hash tables using them, IIUC. Strange thing,
> somewhat. Whatever :-).

Yes, that's good.  The code in fix_hash_table can then be deleted.

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, May 20 2024, Gerd Möllmann wrote:
>
>> I've BTW also protected all the user-defined hash test functions in some
>> commit today, which are malloc'd in fns.c. Reason is that these persist
>> beyond the lifetime of hash tables using them, IIUC. Strange thing,
>> somewhat. Whatever :-).
>
> Yes, that's good.  The code in fix_hash_table can then be deleted.

Right. Thanks, now done.

Re: MPS prstack

[Helmut Eller]

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

On Mon, May 20 2024, Helmut Eller wrote:

> 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:

There is another one: ppstack.  I wasn't able to create a small test
case for this but ppstack is needed when print-circle=t.  The native
compiler uses that a lot.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-ppstack-an-exact-root.patch --]
[-- Type: text/x-diff, Size: 1634 bytes --]

From 61943bbd287efaa8ebf9994be1d536d82456072e Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 22 May 2024 15:03:41 +0200
Subject: [PATCH] Make ppstack an exact root

* src/print.c (grow_pp_stack): Use igc_xpalloc_exact.
(scan_ppstack): New.
---
 src/print.c | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/src/print.c b/src/print.c
index f043da92c1f..c87597be899 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1326,12 +1326,44 @@ #define PRINT_CIRCLE_CANDIDATE_P(obj)			   \
 
 static struct print_pp_stack ppstack = {NULL, 0, 0};
 
+static igc_scan_result_t
+scan_ppstack (struct igc_opaque *op, void *start, void *end,
+	      igc_scan_cell_t scan1)
+{
+  eassert (start == (void *)ppstack.stack);
+  eassert (end == (void *)(ppstack.stack + ppstack.size));
+  struct print_pp_entry *p = start;
+  struct print_pp_entry *q = p + ppstack.sp;
+  for (; p < q; p++)
+    {
+      igc_scan_result_t err = 0;
+      if (p->n == 0)
+	{
+	  if (err = scan1 (op, &p->u.value), err != 0)
+	    return err;
+	}
+      else
+	{
+	  eassert (p->n > 0);
+	  for (size_t i = 0; i < p->n; i++)
+	    if (err = scan1 (op, &p->u.values[i]), err != 0)
+	      return err;
+	}
+    }
+  return 0;
+}
+
 NO_INLINE static void
 grow_pp_stack (void)
 {
   struct print_pp_stack *ps = &ppstack;
   eassert (ps->sp == ps->size);
+#ifdef HAVE_MPS
+  ps->stack = igc_xpalloc_exact (ps->stack, &ps->size, 1, -1,
+				 sizeof *ps->stack, scan_ppstack);
+#else
   ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack);
+#endif
   eassert (ps->sp < ps->size);
 }
 
-- 
2.39.2

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, May 20 2024, Helmut Eller wrote:
>
>> 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:
>
> There is another one: ppstack.  I wasn't able to create a small test
> case for this but ppstack is needed when print-circle=t.  The native
> compiler uses that a lot.

Thanks, and pushed!

Re: MPS prstack

[Helmut Eller]

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

On Wed, May 22 2024, Helmut Eller wrote:

> There is another one: ppstack.  I wasn't able to create a small test
> case for this but ppstack is needed when print-circle=t.  The native
> compiler uses that a lot.

This needs some work.  The patches below should help a bit.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-For-igc_xpalloc_exact-make-PA-an-in-out-parameter.patch --]
[-- Type: text/x-diff, Size: 3498 bytes --]

From 316e6894d6d432be763593b2e8ff816f413264dd Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Fri, 24 May 2024 15:49:23 +0200
Subject: [PATCH 1/2] For igc_xpalloc_exact, make PA an in-out parameter

Because igc_xpalloc_exact uses mps_arena_release the scan_area callback
may be called before igc_xpalloc_exact returns.  With an in-out
parameter, the client has the option to receive the new address before
the igc_xpalloc_exact returns.

* src/igc.h (igc_xpalloc_exact): Change the type of PA.
* src/igc.c (igc_xpalloc_exact): Implement the new protocol.
* src/print.c (grow_pp_stack, grow_print_stack): Update accordingly.
---
 src/igc.c   | 11 ++++++-----
 src/igc.h   |  6 +++---
 src/print.c |  8 ++++----
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/igc.c b/src/igc.c
index dc4512713f7..4f22221e952 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2416,13 +2416,14 @@ scan_xpalloced (mps_ss_t ss, void *start, void *end, void *closure)
   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)
+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)
 {
   IGC_WITH_PARKED (global_igc)
   {
+    void *pa = *pa_cell;
     if (pa)
       {
 	struct igc_root_list *r = root_find (pa);
@@ -2433,8 +2434,8 @@ igc_xpalloc_exact (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
     char *end = (char *)pa + *nitems * item_size;
     root_create (global_igc, pa, end, mps_rank_exact (),
 		 scan_xpalloced, scan_area, false);
+    *pa_cell = pa;
   }
-  return pa;
 }
 
 void *
diff --git a/src/igc.h b/src/igc.h
index fb37ce22e22..5b97787916c 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -84,9 +84,9 @@ #define EMACS_IGC_H
 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_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);
 
 void *igc_xnrealloc_ambig (void *pa, ptrdiff_t nitems, ptrdiff_t item_size);
 
diff --git a/src/print.c b/src/print.c
index c87597be899..5aec73c15e3 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1359,8 +1359,8 @@ grow_pp_stack (void)
   struct print_pp_stack *ps = &ppstack;
   eassert (ps->sp == ps->size);
 #ifdef HAVE_MPS
-  ps->stack = igc_xpalloc_exact (ps->stack, &ps->size, 1, -1,
-				 sizeof *ps->stack, scan_ppstack);
+  igc_xpalloc_exact ((void **)&ppstack.stack, &ps->size, 1, -1,
+		     sizeof *ps->stack, scan_ppstack);
 #else
   ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack);
 #endif
@@ -2273,8 +2273,8 @@ 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);
+  igc_xpalloc_exact ((void **)&prstack.stack, &ps->size, 1, -1,
+		     sizeof *ps->stack, scan_prstack);
 #else
   ps->stack = xpalloc (ps->stack, &ps->size, 1, -1, sizeof *ps->stack);
 #endif
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Safer-use-of-ppstack.patch --]
[-- Type: text/x-diff, Size: 3113 bytes --]

From dd2033d482a29dff2275daf082148ffc2bea16fd Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Fri, 24 May 2024 16:00:12 +0200
Subject: [PATCH 2/2] Safer use of ppstack

In print_pp_entry, the u.values fields holds a pointer into the interior
of a vectorlike object.  This doesn't work for a moving GC.  It's safer
to keep the original object and access it with AREF.

* print.c (print_pp_entry): Add a vectorlike variant to the union.
(scan_ppstack, pp_stack_push_values, print_preprocess): Update accordingly.
---
 src/print.c | 34 ++++++++++++++++++++++++++++++----
 1 file changed, 30 insertions(+), 4 deletions(-)

diff --git a/src/print.c b/src/print.c
index 5aec73c15e3..cc86e1e9710 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1314,7 +1314,11 @@ #define PRINT_CIRCLE_CANDIDATE_P(obj)			   \
   ptrdiff_t n;			/* number of values, or 0 if a single value */
   union {
     Lisp_Object value;		/* when n = 0 */
+#ifdef HAVE_MPS
+    Lisp_Object vectorlike;	/* when n > 0 */
+#else
     Lisp_Object *values;	/* when n > 0 */
+#endif
   } u;
 };
 
@@ -1345,9 +1349,8 @@ scan_ppstack (struct igc_opaque *op, void *start, void *end,
       else
 	{
 	  eassert (p->n > 0);
-	  for (size_t i = 0; i < p->n; i++)
-	    if (err = scan1 (op, &p->u.values[i]), err != 0)
-	      return err;
+	  if (err = scan1 (op, &p->u.vectorlike), err != 0)
+	    return err;
 	}
     }
   return 0;
@@ -1376,6 +1379,20 @@ pp_stack_push_value (Lisp_Object value)
 							.u.value = value};
 }
 
+#ifdef HAVE_MPS
+static inline void
+pp_stack_push_values (Lisp_Object vectorlike, ptrdiff_t n)
+{
+  eassert (VECTORLIKEP (vectorlike));
+  eassume (n >= 0);
+  if (n == 0)
+    return;
+  if (ppstack.sp >= ppstack.size)
+    grow_pp_stack ();
+  ppstack.stack[ppstack.sp++]
+      = (struct print_pp_entry){ .n = n, .u.vectorlike = vectorlike };
+}
+#else
 static inline void
 pp_stack_push_values (Lisp_Object *values, ptrdiff_t n)
 {
@@ -1387,6 +1404,7 @@ pp_stack_push_values (Lisp_Object *values, ptrdiff_t n)
   ppstack.stack[ppstack.sp++] = (struct print_pp_entry){.n = n,
 							.u.values = values};
 }
+#endif
 
 static inline bool
 pp_stack_empty_p (void)
@@ -1409,7 +1427,11 @@ pp_stack_pop (void)
   e->n--;
   if (e->n == 0)
     --ppstack.sp;		/* last value consumed */
+#ifdef HAVE_MPS
+  return AREF (e->u.vectorlike, e->n);
+#else
   return (++e->u.values)[-1];
+#endif
 }
 
 /* Construct Vprint_number_table for the print-circle feature
@@ -1475,13 +1497,17 @@ print_preprocess (Lisp_Object obj)
 
 		case Lisp_Vectorlike:
 		  {
-		    struct Lisp_Vector *vec = XVECTOR (obj);
 		    ptrdiff_t size = ASIZE (obj);
 		    if (size & PSEUDOVECTOR_FLAG)
 		      size &= PSEUDOVECTOR_SIZE_MASK;
 		    ptrdiff_t start = (SUB_CHAR_TABLE_P (obj)
 				       ? SUB_CHAR_TABLE_OFFSET : 0);
+#ifdef HAVE_MPS
+		    pp_stack_push_values (obj, size - start);
+#else
+		    struct Lisp_Vector *vec = XVECTOR (obj);
 		    pp_stack_push_values (vec->contents + start, size - start);
+#endif
 		    if (HASH_TABLE_P (obj))
 		      {
 			struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
-- 
2.39.2

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Wed, May 22 2024, Helmut Eller wrote:
>
>> There is another one: ppstack.  I wasn't able to create a small test
>> case for this but ppstack is needed when print-circle=t.  The native
>> compiler uses that a lot.
>
> This needs some work.  The patches below should help a bit.

Pushed. Thanks!

Re: MPS prstack

[Gerd Möllmann]

Gerd Möllmann <gerd.moellmann@gmail.com> writes:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Wed, May 22 2024, Helmut Eller wrote:
>>
>>> There is another one: ppstack.  I wasn't able to create a small test
>>> case for this but ppstack is needed when print-circle=t.  The native
>>> compiler uses that a lot.
>>
>> This needs some work.  The patches below should help a bit.
>
> Pushed. Thanks!

Moint Helmut. I've pushed another fix that prevents processing non-Lisp
objs in sub char-tables.

Re: MPS prstack

[Helmut Eller]

On Sat, May 25 2024, Gerd Möllmann wrote:

> Moint Helmut. I've pushed another fix that prevents processing non-Lisp
> objs in sub char-tables.

Oops.  Would be nice if print-tests.el would cover some of the more
exotic cases.

Somewhat related: I wonder if this line in print_stack_push is safe:

  prstack.stack[prstack.sp++] = e;

This is not an atomic operation and prstack.sp gets updated before the
new stack slot is initialized.  In theory, there is a small time window
where scan_prstack can see the new prstack.sp but not the new value for
the slot.  Do we need to worry about such issues?

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Sat, May 25 2024, Gerd Möllmann wrote:
>
>> Moint Helmut. I've pushed another fix that prevents processing non-Lisp
>> objs in sub char-tables.
>
> Oops.  Would be nice if print-tests.el would cover some of the more
> exotic cases.
>
> Somewhat related: I wonder if this line in print_stack_push is safe:
>
>   prstack.stack[prstack.sp++] = e;
>
> This is not an atomic operation and prstack.sp gets updated before the
> new stack slot is initialized.  In theory, there is a small time window
> where scan_prstack can see the new prstack.sp but not the new value for
> the slot.  Do we need to worry about such issues?

Hm. No idea when the increment is sequenced. The side effect of postfix
++ could be applied anywhere before the next sequence point. But where
is that sequence point? There is one at the end of the whole expression
I think.

Reminds me why I avoid postfix ++ and -- :-)

Re: MPS prstack

[Helmut Eller]

On Mon, May 27 2024, Gerd Möllmann wrote:

>>   prstack.stack[prstack.sp++] = e;
>
> Hm. No idea when the increment is sequenced. The side effect of postfix
> ++ could be applied anywhere before the next sequence point. But where
> is that sequence point? There is one at the end of the whole expression
> I think.

The generated code with O0 looks like this:

   ...
   0x000055555587fcb1 <+28>:    call   0x55555587fbd0 <grow_print_stack>
   0x000055555587fcb6 <+33>:    mov    0x8845c3(%rip),%rcx        # 0x555556104280 <prstack>
   0x000055555587fcbd <+40>:    mov    0x8845cc(%rip),%rax        # 0x555556104290 <prstack+16>
   0x000055555587fcc4 <+47>:    lea    0x1(%rax),%rdx
   0x000055555587fcc8 <+51>:    mov    %rdx,0x8845c1(%rip)        # 0x555556104290 <prstack+16>
   0x000055555587fccf <+58>:    mov    %rax,%rdx
   0x000055555587fcd2 <+61>:    mov    %rdx,%rax
   0x000055555587fcd5 <+64>:    shl    $0x3,%rax
   0x000055555587fcd9 <+68>:    sub    %rdx,%rax
   0x000055555587fcdc <+71>:    shl    $0x3,%rax
   0x000055555587fce0 <+75>:    add    %rcx,%rax
   0x000055555587fce3 <+78>:    mov    0x10(%rbp),%rcx
   0x000055555587fce7 <+82>:    mov    0x18(%rbp),%rbx
   ...

So it looks like prstack.sp is updated with the move at +51, i.e. before
the stack slot is initialized.

We could write

  prstack.stack[prstack.sp] = e;
  prstack.sp += 1;

Not sure how we then guarantee that e still in a register or the control
stack at the second line.

But my question was more whether MPS actually does call scan_prstack at
"any moment" or if this is just a theoretical possibility for some
possible future version of MPS.

Re: MPS prstack

[Gerd Möllmann]

Helmut Eller <eller.helmut@gmail.com> writes:

> On Mon, May 27 2024, Gerd Möllmann wrote:
>
>>>   prstack.stack[prstack.sp++] = e;
>>
>> Hm. No idea when the increment is sequenced. The side effect of postfix
>> ++ could be applied anywhere before the next sequence point. But where
>> is that sequence point? There is one at the end of the whole expression
>> I think.
>
> The generated code with O0 looks like this:
>
>    ...
>    0x000055555587fcb1 <+28>:    call   0x55555587fbd0 <grow_print_stack>
>    0x000055555587fcb6 <+33>:    mov    0x8845c3(%rip),%rcx        # 0x555556104280 <prstack>
>    0x000055555587fcbd <+40>:    mov    0x8845cc(%rip),%rax        # 0x555556104290 <prstack+16>
>    0x000055555587fcc4 <+47>:    lea    0x1(%rax),%rdx
>    0x000055555587fcc8 <+51>:    mov    %rdx,0x8845c1(%rip)        # 0x555556104290 <prstack+16>
>    0x000055555587fccf <+58>:    mov    %rax,%rdx
>    0x000055555587fcd2 <+61>:    mov    %rdx,%rax
>    0x000055555587fcd5 <+64>:    shl    $0x3,%rax
>    0x000055555587fcd9 <+68>:    sub    %rdx,%rax
>    0x000055555587fcdc <+71>:    shl    $0x3,%rax
>    0x000055555587fce0 <+75>:    add    %rcx,%rax
>    0x000055555587fce3 <+78>:    mov    0x10(%rbp),%rcx
>    0x000055555587fce7 <+82>:    mov    0x18(%rbp),%rbx
>    ...
>
> So it looks like prstack.sp is updated with the move at +51, i.e. before
> the stack slot is initialized.
>
> We could write
>
>   prstack.stack[prstack.sp] = e;
>   prstack.sp += 1;
>
> Not sure how we then guarantee that e still in a register or the control
> stack at the second line.
>
> But my question was more whether MPS actually does call scan_prstack at
> "any moment" or if this is just a theoretical possibility for some
> possible future version of MPS.

I think it is "at any moment". At least I can't find anything in the
docs hinting at something else.

Which probably means that we can't wholy trust stack points. They may be
off.

Re: MPS prstack

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  Emacs Devel <emacs-devel@gnu.org>
> Date: Mon, 27 May 2024 11:15:35 +0200
> 
> We could write
> 
>   prstack.stack[prstack.sp] = e;
>   prstack.sp += 1;

You could, but AFAIU it's equivalent to the original code.

A compiler is allowed to reorder code if doing so doesn't change the
outcome.  So a valid translation of the above by the compiler would be
something like

  temp = prstack.sp;
  prstack.sp += 1;
  prstack.stack[temp] = e;

> Not sure how we then guarantee that e still in a register or the control
> stack at the second line.
> 
> But my question was more whether MPS actually does call scan_prstack at
> "any moment" or if this is just a theoretical possibility for some
> possible future version of MPS.

Why is all this order important, can you elaborate?  Neither MPS nor
we can rely on the order in which the generated code does this stuff,
AFAIU.

Re: MPS prstack

[Helmut Eller]

On Mon, May 27 2024, Eli Zaretskii wrote:

>> But my question was more whether MPS actually does call scan_prstack at
>> "any moment" or if this is just a theoretical possibility for some
>> possible future version of MPS.
>
> Why is all this order important, can you elaborate?  Neither MPS nor
> we can rely on the order in which the generated code does this stuff,
> AFAIU.

It is important because scan_prstack only scans the region
prstack.stack[0..prstack.sp] and because scan_prstack runs (potentially)
concurrent to print_stack_push.

If print_stack_push increments prstack.sp before initializing
prstack.stack[prstack.sp], then scan_prstack may read the old value out
of that slot.

That a compiler will "rewrite"

   prstack.stack[prstack.sp] = e;
   prstack.sp += 1;

to 

   prstack.sp += 1;
   prstack.stack[prstack.sp - 1] = e;

seems very unlikely the me.  But granted, compilers are known to do
unhelpful things in the name of optimization.

Re: MPS prstack

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: gerd.moellmann@gmail.com,  emacs-devel@gnu.org
> Date: Mon, 27 May 2024 14:39:37 +0200
> 
> On Mon, May 27 2024, Eli Zaretskii wrote:
> 
> >> But my question was more whether MPS actually does call scan_prstack at
> >> "any moment" or if this is just a theoretical possibility for some
> >> possible future version of MPS.
> >
> > Why is all this order important, can you elaborate?  Neither MPS nor
> > we can rely on the order in which the generated code does this stuff,
> > AFAIU.
> 
> It is important because scan_prstack only scans the region
> prstack.stack[0..prstack.sp] and because scan_prstack runs (potentially)
> concurrent to print_stack_push.
> 
> If print_stack_push increments prstack.sp before initializing
> prstack.stack[prstack.sp], then scan_prstack may read the old value out
> of that slot.

If we need to make sure that "prstack.stack[prstack.sp++] = e;" is
done atomically, maybe we can use the __atomic builtins (see the node
"__atomic Builtins" in the GCC manual).

Re: MPS prstack

[Helmut Eller]

On Mon, May 27 2024, Eli Zaretskii wrote:

>> If print_stack_push increments prstack.sp before initializing
>> prstack.stack[prstack.sp], then scan_prstack may read the old value out
>> of that slot.
>
> If we need to make sure that "prstack.stack[prstack.sp++] = e;" is
> done atomically, maybe we can use the __atomic builtins (see the node
> "__atomic Builtins" in the GCC manual).

Yes.  I think 

  prstack.stack[prstack.sp] = e;
  __atomic_store_n (&prstack.sp, prstack.sp + 1, __ATOMIC_SEQ_CST);

is quite sufficient.

Re: MPS prstack

[Mattias Engdegård]

27 maj 2024 kl. 16.15 skrev Helmut Eller <eller.helmut@gmail.com>:

>  prstack.stack[prstack.sp] = e;
>  __atomic_store_n (&prstack.sp, prstack.sp + 1, __ATOMIC_SEQ_CST);

Surely that is a severe overkill when all we need is a compiler barrier?
Or have I misunderstood the context the scanners are called in?
Shouldn't they have the same view of memory as the mutator?

Re: MPS prstack

[Helmut Eller]

On Mon, May 27 2024, Mattias Engdegård wrote:

> 27 maj 2024 kl. 16.15 skrev Helmut Eller <eller.helmut@gmail.com>:
>
>>  prstack.stack[prstack.sp] = e;
>>  __atomic_store_n (&prstack.sp, prstack.sp + 1, __ATOMIC_SEQ_CST);
>
> Surely that is a severe overkill when all we need is a compiler barrier?
> Or have I misunderstood the context the scanners are called in?
> Shouldn't they have the same view of memory as the mutator?

The __atomic_store_n mainly prevents the compiler from reordering
instructions.  The generated code uses xchg in one version and mov in
the other.  I doubt that it makes any difference to the hardware, but
using __atomic_store_n documents a subtle point.

Re: MPS prstack

[Po Lu]

Helmut Eller <eller.helmut@gmail.com> writes:

> Yes.  I think 
>
>   prstack.stack[prstack.sp] = e;
>   __atomic_store_n (&prstack.sp, prstack.sp + 1, __ATOMIC_SEQ_CST);
>
> is quite sufficient.

How so?  This doesn't guarantee that MPS cannot pause the thread after E
is saved into prstack but before prstack.sp is incremented, or that E
will remain on the control stack or in the register file until it is.

Re: MPS prstack

[Helmut Eller]

On Mon, May 27 2024, Po Lu wrote:

> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> Yes.  I think 
>>
>>   prstack.stack[prstack.sp] = e;
>>   __atomic_store_n (&prstack.sp, prstack.sp + 1, __ATOMIC_SEQ_CST);
>>
>> is quite sufficient.
>
> How so?  This doesn't guarantee that MPS cannot pause the thread after E
> is saved into prstack but before prstack.sp is incremented,

Right.  But we are sure that prstack.sp is not incremented before E is
saved.  And scan_prstack doesn't care what is beyond prstack.sp.

> or that E
> will remain on the control stack or in the register file until it is.

Yes.  But that's another issue.  That could be solved by making
print_stack_push a non-inline function that takes a reference to E as
argument.

Re: MPS prstack

[Eli Zaretskii]

> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  Emacs Devel <emacs-devel@gnu.org>
> Date: Mon, 27 May 2024 09:27:31 +0200
> 
> Somewhat related: I wonder if this line in print_stack_push is safe:
> 
>   prstack.stack[prstack.sp++] = e;
> 
> This is not an atomic operation and prstack.sp gets updated before the
> new stack slot is initialized.

Are you sure?  I think the above assigns e to
prstack.stack[prstack.sp], and then increments prstack.sp.  What you
describe is this instead:

  prstack.stack[++prstack.sp] = e;

By analogy with the original code above, what does the following do?

  char *s;
  *s++ = 'a';

AFAIU, it stores 'a' in the address pointed by s and then increments
s.