From: Helmut Eller <eller.helmut@gmail.com>
To: "Gerd Möllmann" <gerd.moellmann@gmail.com>
Cc: Eli Zaretskii <eliz@gnu.org>, Emacs Devel <emacs-devel@gnu.org>
Subject: MPS prstack
Date: Mon, 20 May 2024 19:54:49 +0200 [thread overview]
Message-ID: <87o790qsgm.fsf@gmail.com> (raw)
[-- 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
next reply other threads:[~2024-05-20 17:54 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-05-20 17:54 Helmut Eller [this message]
2024-05-20 18:21 ` MPS prstack 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87o790qsgm.fsf@gmail.com \
--to=eller.helmut@gmail.com \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=gerd.moellmann@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).