* MPS: Update
@ 2024-06-10 13:39 Gerd Möllmann
2024-06-10 16:17 ` Andrea Corallo
2024-06-11 20:35 ` Helmut Eller
0 siblings, 2 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-10 13:39 UTC (permalink / raw)
To: Emacs Devel
I now have code to copy the dump to MPS in my fork at
https://github.com/gerd-moellmann/emacs-with-cl-packages/tree/igc
The whole copying and so on takes a total of 0.032s with an optimized
build on my machine. The hot part of the dump is discarded after the
copy.
I've not transferred that to GNU because I'm now through with it, for
the time being. I can't see it anymore. Please anyone feel free to
transfer this to GNU, but keep in mind that I don't have obarrays and
pure space in my fork, so some work will certainly have to be done to
make it work.
Maybe I'll pick this up again when new releases of libgccjit or MPS
make native compilation + MPS work on macOS/arm64.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 13:39 MPS: Update Gerd Möllmann
@ 2024-06-10 16:17 ` Andrea Corallo
2024-06-10 16:26 ` Gerd Möllmann
2024-06-11 20:35 ` Helmut Eller
1 sibling, 1 reply; 62+ messages in thread
From: Andrea Corallo @ 2024-06-10 16:17 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Emacs Devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> I now have code to copy the dump to MPS in my fork at
>
> https://github.com/gerd-moellmann/emacs-with-cl-packages/tree/igc
>
> The whole copying and so on takes a total of 0.032s with an optimized
> build on my machine. The hot part of the dump is discarded after the
> copy.
>
> I've not transferred that to GNU because I'm now through with it, for
> the time being. I can't see it anymore. Please anyone feel free to
> transfer this to GNU, but keep in mind that I don't have obarrays and
> pure space in my fork, so some work will certainly have to be done to
> make it work.
>
> Maybe I'll pick this up again when new releases of libgccjit or MPS
> make native compilation + MPS work on macOS/arm64.
Hi Gerd,
why do you expect a new libgccjit should make native compilation + MPS
work on macOS/arm64? Has a bug being identified in libgccjit on this
target?
Thanks
Andrea
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 16:17 ` Andrea Corallo
@ 2024-06-10 16:26 ` Gerd Möllmann
2024-06-10 16:44 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-10 16:26 UTC (permalink / raw)
To: Andrea Corallo; +Cc: Emacs Devel
Andrea Corallo <acorallo@gnu.org> writes:
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>> Maybe I'll pick this up again when new releases of libgccjit or MPS
>> make native compilation + MPS work on macOS/arm64.
>
> Hi Gerd,
>
> why do you expect a new libgccjit should make native compilation + MPS
> work on macOS/arm64? Has a bug being identified in libgccjit on this
> target?
I don't expect that, but I've seen a number of commits in GCC that
relate to GCC, so it could be. That's all.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 16:26 ` Gerd Möllmann
@ 2024-06-10 16:44 ` Gerd Möllmann
2024-06-10 20:58 ` Andrea Corallo
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-10 16:44 UTC (permalink / raw)
To: Andrea Corallo; +Cc: Emacs Devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Andrea Corallo <acorallo@gnu.org> writes:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> Maybe I'll pick this up again when new releases of libgccjit or MPS
>>> make native compilation + MPS work on macOS/arm64.
>>
>> Hi Gerd,
>>
>> why do you expect a new libgccjit should make native compilation + MPS
>> work on macOS/arm64? Has a bug being identified in libgccjit on this
>> target?
>
> I don't expect that, but I've seen a number of commits in GCC that
> relate to GCC, so it could be. That's all.
^^^^^^^^^^^^^
to arm64, even :-)
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 16:44 ` Gerd Möllmann
@ 2024-06-10 20:58 ` Andrea Corallo
2024-06-11 3:12 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Andrea Corallo @ 2024-06-10 20:58 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Emacs Devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Andrea Corallo <acorallo@gnu.org> writes:
>>
>>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>>> Maybe I'll pick this up again when new releases of libgccjit or MPS
>>>> make native compilation + MPS work on macOS/arm64.
>>>
>>> Hi Gerd,
>>>
>>> why do you expect a new libgccjit should make native compilation + MPS
>>> work on macOS/arm64? Has a bug being identified in libgccjit on this
>>> target?
>>
>> I don't expect that, but I've seen a number of commits in GCC that
>> relate to GCC, so it could be. That's all.
> ^^^^^^^^^^^^^
> to arm64, even :-)
Mmmhh, AArch64 commits in GCC are very frequent, for the kind of simple
code we generate I would not hold my breath the issue is there.
BTW I've access to aarch64 and arm GNU/Linux machines, in case you want
me to perform some specific test please feel free to ask.
Andrea
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 20:58 ` Andrea Corallo
@ 2024-06-11 3:12 ` Gerd Möllmann
0 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-11 3:12 UTC (permalink / raw)
To: Andrea Corallo; +Cc: Emacs Devel
Andrea Corallo <acorallo@gnu.org> writes:
> Mmmhh, AArch64 commits in GCC are very frequent, for the kind of simple
> code we generate I would not hold my breath the issue is there.
>
> BTW I've access to aarch64 and arm GNU/Linux machines, in case you want
> me to perform some specific test please feel free to ask.
Thanks for the offer, maybe later :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-10 13:39 MPS: Update Gerd Möllmann
2024-06-10 16:17 ` Andrea Corallo
@ 2024-06-11 20:35 ` Helmut Eller
2024-06-12 4:45 ` Gerd Möllmann
1 sibling, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-11 20:35 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Emacs Devel
[-- Attachment #1: Type: text/plain, Size: 835 bytes --]
On Mon, Jun 10 2024, Gerd Möllmann wrote:
> I now have code to copy the dump to MPS in my fork at
>
> https://github.com/gerd-moellmann/emacs-with-cl-packages/tree/igc
>
> The whole copying and so on takes a total of 0.032s with an optimized
> build on my machine. The hot part of the dump is discarded after the
> copy.
>
> I've not transferred that to GNU because I'm now through with it, for
> the time being. I can't see it anymore. Please anyone feel free to
> transfer this to GNU, but keep in mind that I don't have obarrays and
> pure space in my fork, so some work will certainly have to be done to
> make it work.
Here are some patches for obarrays and pure space. I wrote them after
cherry picking these revisions from your repo:
git cherry-pick ce3380d6d8102dd0b704^..5bfc127264bf0f2e4f2fb92
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-WIP-some-fixes-for-pure-space-and-obarrays.patch --]
[-- Type: text/x-diff, Size: 1868 bytes --]
From 58ea72ee7e3b8c6e8f88e54c92c9dd71b9548b5b Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 11 Jun 2024 21:06:25 +0200
Subject: [PATCH 1/3] WIP some fixes for pure space and obarrays
* src/igc.c (mirror_string): Don't change references to rodata.
(mirror_obarray): Mirror the buckets array.
(mirror_vector): Fix typo.
---
src/igc.c | 19 ++++++++++---------
1 file changed, 10 insertions(+), 9 deletions(-)
diff --git a/src/igc.c b/src/igc.c
index b101c61b3c2..ce389f1d2d5 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3976,12 +3976,14 @@ mirror_string (struct igc_mirror *m, struct Lisp_String *s)
/* FIXME: IGC_OBJ_STRING_DATA is currently not used in the dump, which
means string data has no igc_header in the dump. We could leave
the string data alone. Not sure what's best. */
- igc_assert (pdumper_object_p (s->u.s.data));
- ptrdiff_t nbytes = STRING_BYTES (s);
- unsigned char *data = alloc_string_data (nbytes, false);
- memcpy (data, s->u.s.data, nbytes + 1);
- s->u.s.data = data;
-
+ if (s->u.s.size_byte != -2)
+ {
+ igc_assert (pdumper_object_p (s->u.s.data));
+ ptrdiff_t nbytes = STRING_BYTES (s);
+ unsigned char *data = alloc_string_data (nbytes, false);
+ memcpy (data, s->u.s.data, nbytes + 1);
+ s->u.s.data = data;
+ }
IGC_MIRROR_RAW (m, &s->u.s.intervals);
}
@@ -4103,8 +4105,7 @@ #define IGC_MIRROR_VECTORLIKE(m, v) \
static void
mirror_obarray (struct igc_mirror *m, struct Lisp_Obarray *o)
{
- if (o->buckets)
- IGC_MIRROR_NOBJS (m, o->buckets, obarray_size (o));
+ IGC_MIRROR_RAW (m, &o->buckets);
}
#endif
@@ -4304,7 +4305,7 @@ mirror_vector (struct igc_mirror *m, void *client)
{
#ifndef IN_MY_FORK
case PVEC_OBARRAY:
- mirror_obarray (c, client);
+ mirror_obarray (m, client);
break;
#endif
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Dump-IGC_OBJ_STRING_DATA-with-headers.patch --]
[-- Type: text/x-diff, Size: 5811 bytes --]
From 8f9c59f8c51cd771a5baf06e1a5f309432a0dba3 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 11 Jun 2024 21:14:21 +0200
Subject: [PATCH 2/3] Dump IGC_OBJ_STRING_DATA with headers
This makes the mirroring code more uniform.
* src/pdumper.c (dump_cold_string): Emit headers.
* src/igc.c (igc_dump_finish_obj): Handle objects in pure space.
(builtin_obj_type_and_hash): Renamed from builtin_obj_type.
(pure_obj_type_and_hash): New helper.
(is_builtin_obj_type): Abort for unrecognized cases.
(mirror_string): Don't copy strings in the cold dump.
---
src/igc.c | 68 ++++++++++++++++++++++++++++++++-------------------
src/pdumper.c | 8 ++++++
2 files changed, 51 insertions(+), 25 deletions(-)
diff --git a/src/igc.c b/src/igc.c
index ce389f1d2d5..713be9308dd 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -109,6 +109,9 @@ #define igc_assert(expr) \
#define igc_static_assert(x) verify (x)
#define igc_const_cast(type, expr) ((type) (expr))
+#define NOT_IMPLEMENTED() \
+ igc_assert_fail (__FILE__, __LINE__, "not implemented")
+
#define IGC_TAG_MASK (~VALMASK)
/* Using mps_arena_has_addr is expensive. so try to do something that is
@@ -3579,17 +3582,42 @@ is_builtin_subr (enum igc_obj_type type, void *client)
}
static enum igc_obj_type
-builtin_obj_type (enum igc_obj_type type, void *client)
+builtin_obj_type_and_hash (size_t *hash, enum igc_obj_type type, void *client)
{
if (c_symbol_p (client))
- return IGC_OBJ_BUILTIN_SYMBOL;
+ return *hash = igc_hash (make_lisp_symbol (client)),
+ IGC_OBJ_BUILTIN_SYMBOL;
if (client == &main_thread)
- return IGC_OBJ_BUILTIN_THREAD;
+ return *hash = igc_hash (make_lisp_ptr (client, Lisp_Vectorlike)),
+ IGC_OBJ_BUILTIN_THREAD;
if (is_builtin_subr (type, client))
- return IGC_OBJ_BUILTIN_SUBR;
+ return *hash = igc_hash (make_lisp_ptr (client, Lisp_Vectorlike)),
+ IGC_OBJ_BUILTIN_SUBR;
emacs_abort ();
}
+static enum igc_obj_type
+pure_obj_type_and_hash (size_t *hash_o, enum igc_obj_type type, void *client)
+{
+ switch (type)
+ {
+ case IGC_OBJ_STRING:
+ return *hash_o = igc_hash (make_lisp_ptr (client, Lisp_String)), type;
+ case IGC_OBJ_VECTOR:
+ return *hash_o = igc_hash (make_lisp_ptr (client, Lisp_Vectorlike)),
+ type;
+ case IGC_OBJ_CONS:
+ return *hash_o = igc_hash (make_lisp_ptr (client, Lisp_Cons)), type;
+ case IGC_OBJ_STRING_DATA:
+ return *hash_o = (uintptr_t)client & IGC_HASH_MASK, type;
+ case IGC_OBJ_FLOAT:
+ return *hash_o = igc_hash (make_lisp_ptr (client, Lisp_Float)), type;
+ default:
+ NOT_IMPLEMENTED ();
+ emacs_abort ();
+ }
+}
+
static bool
is_builtin_obj_type (enum igc_obj_type type)
{
@@ -3625,16 +3653,17 @@ is_builtin_obj_type (enum igc_obj_type type)
case IGC_OBJ_BUILTIN_SUBR:
return true;
}
+ emacs_abort();
}
char *
-igc_dump_finish_obj (void *client, enum igc_obj_type type,
- char *base, char *end)
+igc_dump_finish_obj (void *client, enum igc_obj_type type, char *base,
+ char *end)
{
if (client == NULL)
return end;
- struct igc_header *out = (struct igc_header *) base;
+ struct igc_header *out = (struct igc_header *)base;
if (is_mps (client))
{
struct igc_header *h = client_to_base (client);
@@ -3643,13 +3672,15 @@ igc_dump_finish_obj (void *client, enum igc_obj_type type,
*out = *h;
return base + to_bytes (h->nwords);
}
-
size_t client_size = end - base - sizeof *out;
size_t nbytes = obj_size (client_size);
size_t nwords = to_words (nbytes);
- type = builtin_obj_type (type, client);
- *out = (struct igc_header)
- { .obj_type = type, .hash = igc_hash (client), .nwords = nwords };
+ size_t hash;
+ type = is_pure (client) ? pure_obj_type_and_hash (&hash, type, client)
+ : builtin_obj_type_and_hash (&hash, type, client);
+ *out = (struct igc_header){ .obj_type = type,
+ .hash = hash,
+ .nwords = nwords };
return base + nbytes;
}
@@ -3973,17 +4004,7 @@ mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym)
static void
mirror_string (struct igc_mirror *m, struct Lisp_String *s)
{
- /* FIXME: IGC_OBJ_STRING_DATA is currently not used in the dump, which
- means string data has no igc_header in the dump. We could leave
- the string data alone. Not sure what's best. */
- if (s->u.s.size_byte != -2)
- {
- igc_assert (pdumper_object_p (s->u.s.data));
- ptrdiff_t nbytes = STRING_BYTES (s);
- unsigned char *data = alloc_string_data (nbytes, false);
- memcpy (data, s->u.s.data, nbytes + 1);
- s->u.s.data = data;
- }
+ IGC_MIRROR_RAW (m, &s->u.s.data);
IGC_MIRROR_RAW (m, &s->u.s.intervals);
}
@@ -3999,9 +4020,6 @@ mirror_interval (struct igc_mirror *m, struct interval *i)
IGC_MIRROR_OBJ (m, &i->plist);
}
-#define NOT_IMPLEMENTED() \
- igc_assert_fail (__FILE__, __LINE__, "not implemented")
-
static void
mirror_itree_tree (struct igc_mirror *m, struct itree_tree *t)
{
diff --git a/src/pdumper.c b/src/pdumper.c
index b487bc39b43..aecb7ab1a16 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -3556,11 +3556,19 @@ dump_cold_string (struct dump_context *ctx, Lisp_Object string)
error ("string too large");
dump_off total_size = ptrdiff_t_to_dump_off (SBYTES (string) + 1);
eassert (total_size > 0);
+
+# ifdef HAVE_MPS
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_igc_start_obj (ctx, IGC_OBJ_STRING_DATA, XSTRING (string)->u.s.data);
+# endif
dump_remember_fixup_ptr_raw
(ctx,
string_offset + dump_offsetof (struct Lisp_String, u.s.data),
ctx->offset);
dump_write (ctx, XSTRING (string)->u.s.data, total_size);
+# ifdef HAVE_MPS
+ dump_igc_finish_obj (ctx);
+# endif
}
static void
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Fix-some-compiler-warnings.patch --]
[-- Type: text/x-diff, Size: 1293 bytes --]
From c4a30a7f5446bef207d04d52fe83ca9071bc2e4c Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 11 Jun 2024 21:22:31 +0200
Subject: [PATCH 3/3] Fix some compiler warnings
* src/igc.h (igc_alloc_lisp_obj_vec): Remove redundant declaration.
* src/igc.c: Remove warning about HAVE_TEXT_CONVERSION. It's not helpful.
---
src/igc.c | 4 ----
src/igc.h | 1 -
2 files changed, 5 deletions(-)
diff --git a/src/igc.c b/src/igc.c
index 713be9308dd..112167848a4 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -64,10 +64,6 @@
#ifndef HAVE_PDUMPER
# error "HAVE_PDUMPER required"
#endif
-#ifdef HAVE_TEXT_CONVERSION
-//# error "HAVE_TEXT_CONVERSION not supported"
-# warning "HAVE_TEXT_CONVERSION not supported"
-#endif
struct Lisp_Weak_Ref
{
diff --git a/src/igc.h b/src/igc.h
index a647fbca887..c0bed80503a 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -111,7 +111,6 @@ #define EMACS_IGC_H
void *igc_grow_ptr_vec (void *v, ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max);
void igc_grow_rdstack (struct read_stack *rs);
Lisp_Object *igc_make_hash_table_vec (size_t n);
-Lisp_Object *igc_alloc_lisp_obj_vec (size_t n);
void *igc_alloc_bytes (size_t nbytes);
struct image_cache *igc_make_image_cache (void);
struct interval *igc_make_interval (void);
--
2.39.2
^ permalink raw reply related [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-11 20:35 ` Helmut Eller
@ 2024-06-12 4:45 ` Gerd Möllmann
2024-06-12 7:54 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-12 4:45 UTC (permalink / raw)
To: Helmut Eller; +Cc: Emacs Devel
Helmut Eller <eller.helmut@gmail.com> writes:
> On Mon, Jun 10 2024, Gerd Möllmann wrote:
>
>> I now have code to copy the dump to MPS in my fork at
>>
>> https://github.com/gerd-moellmann/emacs-with-cl-packages/tree/igc
>>
>> The whole copying and so on takes a total of 0.032s with an optimized
>> build on my machine. The hot part of the dump is discarded after the
>> copy.
>>
>> I've not transferred that to GNU because I'm now through with it, for
>> the time being. I can't see it anymore. Please anyone feel free to
>> transfer this to GNU, but keep in mind that I don't have obarrays and
>> pure space in my fork, so some work will certainly have to be done to
>> make it work.
>
> Here are some patches for obarrays and pure space. I wrote them after
> cherry picking these revisions from your repo:
>
> git cherry-pick ce3380d6d8102dd0b704^..5bfc127264bf0f2e4f2fb92
Thanks! "Merged" in and pushed.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-12 4:45 ` Gerd Möllmann
@ 2024-06-12 7:54 ` Eli Zaretskii
2024-06-12 8:00 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-12 7:54 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Emacs Devel <emacs-devel@gnu.org>
> Date: Wed, 12 Jun 2024 06:45:06 +0200
>
> Helmut Eller <eller.helmut@gmail.com> writes:
>
> > On Mon, Jun 10 2024, Gerd Möllmann wrote:
> >
> >> I now have code to copy the dump to MPS in my fork at
> >>
> >> https://github.com/gerd-moellmann/emacs-with-cl-packages/tree/igc
> >>
> >> The whole copying and so on takes a total of 0.032s with an optimized
> >> build on my machine. The hot part of the dump is discarded after the
> >> copy.
> >>
> >> I've not transferred that to GNU because I'm now through with it, for
> >> the time being. I can't see it anymore. Please anyone feel free to
> >> transfer this to GNU, but keep in mind that I don't have obarrays and
> >> pure space in my fork, so some work will certainly have to be done to
> >> make it work.
> >
> > Here are some patches for obarrays and pure space. I wrote them after
> > cherry picking these revisions from your repo:
> >
> > git cherry-pick ce3380d6d8102dd0b704^..5bfc127264bf0f2e4f2fb92
>
> Thanks! "Merged" in and pushed.
Did you forget to push? I don't see any commit on the igc branch
after June 4.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS: Update
2024-06-12 7:54 ` Eli Zaretskii
@ 2024-06-12 8:00 ` Gerd Möllmann
2024-06-13 9:07 ` MPS codegen (was: MPS: Update) Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-12 8:00 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> Thanks! "Merged" in and pushed.
>
> Did you forget to push? I don't see any commit on the igc branch
> after June 4.
The patches were for my fork.
^ permalink raw reply [flat|nested] 62+ messages in thread
* MPS codegen (was: MPS: Update)
2024-06-12 8:00 ` Gerd Möllmann
@ 2024-06-13 9:07 ` Helmut Eller
2024-06-13 12:33 ` MPS codegen Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-13 9:07 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 293 bytes --]
The patches below use a code generator for most of the fix an mirror
functions. I dropped tree-sitter for now; maybe it can be used for
something later. The code generator is about 800 lines and the
generated code 1600. However the generated code is longer than hand
written code. WDYT?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-WIP-Generate-code-for-scan-methods.patch --]
[-- Type: text/x-diff, Size: 40454 bytes --]
From 19f992b8ea59c2c106da2caf8c6208c16252ea97 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Fri, 7 Jun 2024 14:09:48 +0200
Subject: [PATCH 1/5] WIP Generate code for scan methods
* admin/igc-codegen.el: New file.
* src/Makefile.in: New rule for igc-generated.c
* srg/igc.c: Include the generated code.
---
admin/igc-codegen.el | 625 +++++++++++++++++++++++++++++++++++++++++++
src/Makefile.in | 3 +
src/igc.c | 353 ++++++++++++++++++------
3 files changed, 904 insertions(+), 77 deletions(-)
create mode 100644 admin/igc-codegen.el
diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el
new file mode 100644
index 00000000000..cefe4111866
--- /dev/null
+++ b/admin/igc-codegen.el
@@ -0,0 +1,625 @@
+;; -*- lexical-binding: t -*-
+
+(require 'treesit)
+(require 'project)
+
+(defmacro igccg--define-record (name &rest fields)
+ (let* ((constructor (intern (format "igccg--make-%s" name)))
+ (conc-name (intern (format "igccg--%s." name)))
+ (tag-name (intern (format "igccg--%s" name))))
+ `(cl-defstruct (,tag-name
+ (:constructor ,constructor (,@fields))
+ (:constructor nil)
+ (:conc-name ,conc-name)
+ (:predicate nil)
+ (:copier nil)
+ (:noinline))
+ ,@(mapcar (lambda (field)
+ `(,field nil :read-only t))
+ fields))))
+
+(igccg--define-record layout name header pvectype tag ctype fields)
+
+(defun igccg--arg-decl (name type)
+ (pcase-exhaustive type
+ (`(* ,type) (igccg--arg-decl (format "*%s" name) type))
+ (`(struct ,s) (format "struct %s %s" s name))
+ (`(array ,type) (igccg--arg-decl (format "%s[]" name) type))
+ (`vectorlike_header (igccg--arg-decl name `(struct Lisp_Vector)))
+ ((guard (symbolp type)) (format "%s %s" type name))))
+
+(defun igccg--type-spec (type)
+ (pcase-exhaustive type
+ (`(* ,type) (format "%s*" (igccg--type-spec type)))
+ (`(struct ,s) (format "struct %s" s))
+ (`(array ,type) (format "%s*" (igccg--type-spec type)))
+ (`vectorlike_header (igccg--type-spec `(struct Lisp_Vector)))
+ ((guard (symbolp type)) (symbol-name type))))
+
+(defvar igccg--indent 0)
+
+(defun igccg--emit-line (string)
+ (princ (format "%s%s\n"
+ (make-string igccg--indent ?\s)
+ string)))
+
+(defun igccg--emit-function (rtype name args body)
+ (princ (format "static %s\n%s (%s)\n{\n" rtype name (string-join args ", ")))
+ (let ((igccg--indent 2))
+ (funcall body))
+ (princ "}\n\n"))
+
+(defun igccg--emit-block (body)
+ (igccg--emit-line "{")
+ (let ((igccg--indent (+ 2 igccg--indent)))
+ (funcall body))
+ (igccg--emit-line "}"))
+
+(defun igccg--emit-switch (exp cases)
+ (igccg--emit-line (format "switch (%s)" exp))
+ (igccg--emit-block (lambda ()
+ (dolist (c cases)
+ (igccg--emit-line
+ (cond ((equal (car c) "default") "default:")
+ (t (format "case %s:" (car c)))))
+ (let ((igccg--indent (+ 2 igccg--indent)))
+ (funcall (cdr c))
+ (igccg--emit-line "break;"))))))
+
+(defun igccg--emit-\#if (exp body)
+ (igccg--emit-line (format "#if %s" exp))
+ (funcall body)
+ (igccg--emit-line "#endif"))
+
+(defun igccg--ifdef-exp (exp)
+ (pcase-exhaustive exp
+ ((guard (symbolp exp)) (format "defined %s" exp))
+ (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || "))))
+
+(defun igccg--emit-scan-body (body)
+ (igccg--emit-line "MPS_SCAN_BEGIN (ss)")
+ (igccg--emit-block body)
+ (igccg--emit-line "MPS_SCAN_END (ss);")
+ (igccg--emit-line "return MPS_RES_OK;"))
+
+(defun igccg--field-addr-exp (var path)
+ (pcase-exhaustive path
+ ((guard (symbolp path))
+ (format "&%s->%s" var path))
+ (`(path . ,symbols)
+ (format "&%s->%s" var (mapconcat #'symbol-name symbols ".")))
+ ((guard (stringp path))
+ (format path var))))
+
+(defun igccg--field-value-exp (var path)
+ (pcase-exhaustive path
+ ((guard (symbolp path))
+ (format "%s->%s" var path))
+ (`(path . ,symbols)
+ (format "%s->%s" var (mapconcat #'symbol-name symbols ".")))
+ ((guard (stringp path))
+ (format path var))
+ ('(pvec-header-size)
+ (format "%s->header.size & PSEUDOVECTOR_SIZE_MASK" var))
+ ('(igc-header-len)
+ (format "((struct igc_header *)client_to_base (%s))->nwords \
+- to_words (sizeof (struct igc_header))" var))
+ ('(sub-char-table-len)
+ (format "(%s->header.size & PSEUDOVECTOR_SIZE_MASK)\
+ - SUB_CHAR_TABLE_OFFSET" var))))
+
+(defun igccg--emit-fix-call (ss type var fname)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, %s, %s, %s);"
+ ss (igccg--type-spec type) var fname)))
+
+(defun igccg--emit-abort ()
+ (igccg--emit-line "emacs_abort ();"))
+
+(defun igccg--emit-fix-field-exp (ss obj exp)
+ (pcase-exhaustive exp
+ (`(tagged ,path)
+ (igccg--emit-line (format "IGC_FIX12_OBJ (%s, %s);"
+ ss (igccg--field-addr-exp obj path))))
+ (`(untagged ,path)
+ (igccg--emit-line (format "IGC_FIX12_RAW (%s, %s);"
+ ss (igccg--field-addr-exp obj path))))
+ (`(switch ,path . ,cases)
+ (igccg--emit-switch
+ (igccg--field-value-exp obj path)
+ (mapcar (lambda (case)
+ (pcase-exhaustive case
+ (`(,tag . ,fields)
+ (cons (symbol-name tag)
+ (lambda ()
+ (mapc (lambda (field)
+ (igccg--emit-fix-field-exp ss obj field))
+ fields))))))
+ cases)))
+ (`(array tagged ,start ,len)
+ (igccg--emit-line
+ (format (concat "IGC_FIX12_NOBJS (%s, %s, %s);")
+ ss
+ (igccg--field-value-exp obj start)
+ (igccg--field-value-exp obj len))))
+ (`(array untagged ,start ,len)
+ (igccg--emit-line
+ (format "size_t len = %s;" (igccg--field-value-exp obj len)))
+ (igccg--emit-line
+ (format "for (void **p = %s, **q = p + len; p < q; p++)"
+ (igccg--field-value-exp obj start)))
+ (igccg--emit-block (lambda ()
+ (igccg--emit-line
+ (format "IGC_FIX12_RAW (%s, p);" ss)))))
+ (`(vectorlike)
+ (igccg--emit-line
+ (format
+ "IGC_FIX12_NOBJS (%s,\
+ (Lisp_Object *)(&%s->header + 1),\
+ %s->header.size & PSEUDOVECTOR_SIZE_MASK);" ss obj obj)))
+ (`(cfg ,test . ,exps)
+ (igccg--emit-\#if (igccg--ifdef-exp test)
+ (lambda ()
+ (mapc (lambda (exp)
+ (igccg--emit-fix-field-exp ss obj exp))
+ exps))))
+ ('(abort)
+ (igccg--emit-abort))
+ ('(frame-quirks)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, struct frame, %s, fix_frame_quirks);"
+ ss obj)))
+ ('(window-quirks)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, struct window, %s, fix_window_quirks);"
+ ss obj)))
+ ('(buffer-quirks)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, struct buffer, %s, fix_buffer_quirks);"
+ ss obj)))
+ ('(terminal-quirks)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, struct terminal, %s, fix_terminal_quirks);"
+ ss obj)))
+ ('(font-object-quirks)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (%s, struct font, %s, fix_font_object_quirks);"
+ ss obj)))))
+
+(defun igccg--fix-method-name (layout)
+ (format "fix_%s" (igccg--layout.name layout)))
+
+(defun igccg--scan-vectorlike-method-name (prefix)
+ (format "%s_scan_vectorlike" prefix))
+
+(defun igccg--emit-fix-method (layout)
+ (igccg--emit-function
+ "mps_res_t"
+ (igccg--fix-method-name layout)
+ (list "mps_ss_t ss" (igccg--arg-decl "o"
+ `(* ,(igccg--layout.ctype layout))))
+ (lambda ()
+ (igccg--emit-scan-body
+ (lambda ()
+ (dolist (exp (igccg--layout.fields layout))
+ (igccg--emit-fix-field-exp "ss" "o" exp)))))))
+
+(defun igccg--emit-scan-vectorlike-method (name layouts)
+ (igccg--emit-function
+ "mps_res_t"
+ name
+ (list "mps_ss_t ss" "struct Lisp_Vector *v")
+ (lambda ()
+ (igccg--emit-scan-body
+ (lambda ()
+ (igccg--emit-switch
+ "pseudo_vector_type (v->header)"
+ (append
+ (mapcar (lambda (l)
+ (cons (symbol-name (igccg--layout.pvectype l))
+ (lambda ()
+ (igccg--emit-fix-call
+ "ss" (igccg--layout.ctype l)
+ "v" (igccg--fix-method-name l)))))
+ layouts)
+ (list (cons 'PVEC_FREE (lambda () (igccg--emit-abort)))))))))))
+
+(defun igccg--emit-scan-object-method (prefix layouts)
+ (mapc #'igccg--emit-fix-method layouts)
+ (let* ((alist (seq-group-by #'igccg--layout.header igccg--layouts ))
+ (vectorlike (cdr (assq 'IGC_OBJ_VECTOR alist)))
+ (scan-vectorlike (igccg--scan-vectorlike-method-name prefix)))
+ (igccg--emit-scan-vectorlike-method scan-vectorlike vectorlike)
+ (igccg--emit-function
+ "mps_res_t"
+ (format "%s_scan_object" prefix)
+ (list "mps_ss_t ss" "mps_addr_t base")
+ (lambda ()
+ (igccg--emit-scan-body
+ (lambda ()
+ (igccg--emit-line "mps_addr_t client = base_to_client (base);")
+ (igccg--emit-line "struct igc_header *header = base;")
+ (igccg--emit-switch
+ "header->obj_type"
+ (append
+ (mapcar
+ (lambda (p)
+ (pcase-exhaustive p
+ (`(,type . (,layout))
+ (cons (symbol-name type)
+ (lambda ()
+ (igccg--emit-fix-call
+ "ss" (igccg--layout.ctype layout)
+ "client" (igccg--fix-method-name layout)))))
+ (`(IGC_OBJ_VECTOR . ,_)
+ (cons "IGC_OBJ_VECTOR"
+ (lambda ()
+ (igccg--emit-fix-call "ss" '(struct Lisp_Vector)
+ "client" scan-vectorlike))))))
+ alist)
+ (list
+ (cons "IGC_OBJ_FWD" (lambda ()))
+ (cons "IGC_OBJ_PAD" (lambda ()))
+ (cons "IGC_OBJ_INVALID" (lambda () (igccg--emit-abort))))))))))))
+
+(defvar igccg--layouts
+ (list
+ (igccg--make-layout
+ 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons '(struct Lisp_Cons)
+ '((tagged (path u s car))
+ (tagged (path u s u cdr))))
+
+ (igccg--make-layout
+ 'symbol 'IGC_OBJ_SYMBOL nil 'Lisp_Symbol '(struct Lisp_Symbol)
+ '((tagged (path u s name))
+ (tagged (path u s function))
+ (tagged (path u s plist))
+ (untagged (path u s next))
+ (switch
+ (path u s redirect)
+ (SYMBOL_PLAINVAL (tagged (path u s val value)))
+ (SYMBOL_VARALIAS (untagged (path u s val alias)))
+ (SYMBOL_LOCALIZED (untagged (path u s val blv)))
+ (SYMBOL_FORWARDED
+ (switch
+ "XFWDTYPE (%s->u.s.val.fwd)"
+ (Lisp_Fwd_Int)
+ (Lisp_Fwd_Bool)
+ (Lisp_Fwd_Kboard_Obj)
+ (Lisp_Fwd_Obj
+ (tagged "((struct Lisp_Objfwd *)(%s->u.s.val.fwd.fwdptr))->objvar"))
+ (Lisp_Fwd_Buffer_Obj
+ (tagged
+ "&\
+((struct Lisp_Buffer_Objfwd *)(%s->u.s.val.fwd.fwdptr))\
+->predicate")))))))
+
+ (igccg--make-layout
+ 'interval 'IGC_OBJ_INTERVAL nil nil '(struct interval)
+ '((untagged left)
+ (untagged right)
+ (switch up_obj
+ (default (tagged (path up obj)))
+ (false (untagged (path up interval))))
+ (tagged plist)))
+
+ (igccg--make-layout
+ 'string 'IGC_OBJ_STRING nil 'Lisp_String '(struct Lisp_String)
+ '((untagged (path u s data))
+ (untagged (path u s intervals))))
+
+ (igccg--make-layout
+ 'string_data 'IGC_OBJ_STRING_DATA nil nil '(array uint8_t) nil)
+
+ (igccg--make-layout
+ 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil '(struct itree_tree)
+ '((untagged root)))
+
+ (igccg--make-layout
+ 'itree_node 'IGC_OBJ_ITREE_NODE nil nil '(struct itree_node)
+ '((untagged parent)
+ (untagged left)
+ (untagged right)
+ (tagged data)))
+
+ (igccg--make-layout
+ 'image 'IGC_OBJ_IMAGE nil nil '(struct image)
+ '((tagged spec)
+ (tagged dependencies)
+ (tagged lisp_data)
+ (untagged next)
+ (untagged prev)))
+
+ (igccg--make-layout
+ 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil '(struct image_cache)
+ '((untagged images)
+ (untagged buckets)))
+
+ (igccg--make-layout
+ 'face 'IGC_OBJ_FACE nil nil '(struct face)
+ '((array tagged lface "ARRAYELTS (%s->lface)")
+ (untagged font)
+ (untagged next)
+ (untagged prev)
+ (untagged ascii_face)
+ (cfg
+ (or HAVE_XFT HAVE_FREETYPE)
+ (untagged extra))))
+
+ (igccg--make-layout
+ 'face_cache 'IGC_OBJ_FACE_CACHE nil nil '(struct face_cache)
+ '((untagged f)
+ (untagged faces_by_id)
+ (untagged buckets)))
+
+ (igccg--make-layout
+ 'float 'IGC_OBJ_FLOAT nil 'Lisp_Float '(struct Lisp_Float)
+ '())
+
+ (igccg--make-layout
+ 'blv 'IGC_OBJ_BLV nil nil '(struct Lisp_Buffer_Local_Value)
+ '((tagged where)
+ (tagged defcell)
+ (tagged valcell)))
+
+ ;; (igccg--make-layout
+ ;; 'weak_ref 'IGC_OBJ_WEAK 'Lisp_Vectorlike '(struct Lisp_Weak_Ref)
+ ;; '((tagged ref)))
+
+ (igccg--make-layout
+ 'ptr_vec 'IGC_OBJ_PTR_VEC nil nil '(* void)
+ '((array untagged "%s" (igc-header-len))))
+
+ (igccg--make-layout
+ 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil 'Lisp_Object
+ '((array tagged "%s" (igc-header-len))))
+
+ (igccg--make-layout
+ 'handler 'IGC_OBJ_HANDLER nil nil '(struct handler)
+ '((tagged tag_or_ch)
+ (tagged val)
+ (untagged next)
+ (untagged nextfree)))
+
+ (igccg--make-layout
+ 'bytes 'IGC_OBJ_BYTES nil nil '(array uint8_t) nil)
+
+ (igccg--make-layout
+ 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike
+ '(struct Lisp_Vector) '((array tagged contents (path header size))))
+
+ (igccg--make-layout
+ 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike
+ '(struct Lisp_Bignum) '())
+
+ (igccg--make-layout
+ 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike
+ '(struct Lisp_Marker)
+ '((untagged buffer)
+ ;;(untagged next)
+ ))
+
+ (igccg--make-layout
+ 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike
+ '(struct Lisp_Overlay)
+ '((untagged buffer)
+ (tagged plist)
+ (untagged interval)))
+
+ (igccg--make-layout
+ 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike
+ '(struct Lisp_Finalizer)
+ '((tagged function)
+ (untagged next)
+ (untagged prev)))
+
+ (igccg--make-layout
+ 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike
+ '(struct Lisp_Symbol_With_Pos)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike
+ '(struct Lisp_Misc_Ptr)
+ '())
+
+ (igccg--make-layout
+ 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike
+ '(struct Lisp_User_Ptr)
+ '())
+
+ (igccg--make-layout
+ 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike
+ '(struct Lisp_Process)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike
+ '(struct frame)
+ '((vectorlike)
+ (untagged face_cache)
+ (untagged terminal)
+ (frame-quirks)))
+
+ (igccg--make-layout
+ 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike
+ '(struct window)
+ '((vectorlike)
+ (tagged prev_buffers)
+ (tagged next_buffers)
+ (window-quirks)))
+
+ (igccg--make-layout
+ 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike
+ '(struct Lisp_Bool_Vector)
+ '())
+
+ (igccg--make-layout
+ 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike
+ '(struct buffer)
+ '((vectorlike)
+ (untagged (path own_text intervals))
+ (untagged (path own_text markers))
+ (untagged overlays)
+ (untagged base_buffer)
+ (tagged undo_list_)
+ (buffer-quirks)))
+
+ (igccg--make-layout
+ 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike
+ '(struct Lisp_Hash_Table)
+ '((untagged key)
+ (untagged value)
+ (untagged hash)
+ (untagged next)
+ (untagged index)))
+
+ (igccg--make-layout
+ 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike
+ '(struct Lisp_Obarray)
+ '((untagged buckets)))
+
+ (igccg--make-layout
+ 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike
+ '(struct terminal)
+ '((vectorlike)
+ (untagged next_terminal)
+ (cfg HAVE_WINDOW_SYSTEM
+ (untagged image_cache))
+ (terminal-quirks)))
+
+ (igccg--make-layout
+ 'window_configuraion 'IGC_OBJ_VECTOR 'PVEC_WINDOW_CONFIGURATION
+ 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike
+ '(struct Lisp_Subr)
+ '((tagged command_modes)
+ (cfg
+ HAVE_NATIVE_COMP
+ (tagged (path intspec native))
+ (tagged native_comp_u)
+ (tagged lambda_list)
+ (tagged type))))
+
+ (igccg--make-layout
+ 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike
+ '(struct scroll_bar)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike
+ '(struct thread_state)
+ '((vectorlike)
+ (untagged m_current_buffer)
+ (untagged next_thread)
+ (untagged m_handlerlist)))
+
+ (igccg--make-layout
+ 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike
+ '(struct Lisp_Mutex)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike
+ '(struct Lisp_CondVar)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike
+ '(struct module_global_reference)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'module_global_reference 'IGC_OBJ_VECTOR 'PVEC_MODULE_GLOBAL_REFERENCE
+ 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'comp_unit 'IGC_OBJ_VECTOR 'PVEC_NATIVE_COMP_UNIT
+ 'Lisp_Vectorlike
+ '(struct Lisp_Native_Comp_Unit)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'ts_parser 'IGC_OBJ_VECTOR 'PVEC_TS_PARSER
+ 'Lisp_Vectorlike
+ '(struct Lisp_TS_Parser)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'ts_node 'IGC_OBJ_VECTOR 'PVEC_TS_NODE
+ 'Lisp_Vectorlike
+ '(struct Lisp_TS_Node)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'ts_query 'IGC_OBJ_VECTOR 'PVEC_TS_COMPILED_QUERY
+ 'Lisp_Vectorlike
+ '(struct Lisp_TS_Query)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'sqlite 'IGC_OBJ_VECTOR 'PVEC_SQLITE
+ 'Lisp_Vectorlike
+ '(struct Lisp_Sqlite)
+ '((vectorlike)))
+
+ ;; (PVEC_WEAK_REF (struct Lisp_Weak_Ref))
+
+ (igccg--make-layout
+ 'closure 'IGC_OBJ_VECTOR 'PVEC_CLOSURE
+ 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'char_table 'IGC_OBJ_VECTOR 'PVEC_CHAR_TABLE
+ 'Lisp_Vectorlike
+ '(struct Lisp_Char_Table)
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'sub_char_table 'IGC_OBJ_VECTOR 'PVEC_SUB_CHAR_TABLE
+ 'Lisp_Vectorlike
+ '(struct Lisp_Sub_Char_Table)
+ '((array tagged contents (sub-char-table-len))))
+
+ (igccg--make-layout
+ 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike
+ 'vectorlike_header
+ '((vectorlike)))
+
+ (igccg--make-layout
+ 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike
+ '(struct Lisp_Vector)
+ '((vectorlike)
+ (switch (pvec-header-size)
+ (FONT_SPEC_MAX)
+ (FONT_ENTITY_MAX)
+ (FONT_OBJECT_MAX (font-object-quirks))
+ (default (abort)))))
+ ))
+
+(defun igccg-main ()
+ (igccg--emit-line "/* Generated by igc-codegen.el */")
+ (igccg--emit-line "#pragma GCC diagnostic push")
+ ;;(igccg--emit-line "#pragma GCC diagnostic ignored \"-Wunused-function\"")
+ (igccg--emit-scan-object-method "dflt" igccg--layouts)
+ (igccg--emit-line "#pragma GCC diagnostic pop"))
+
+;; (igccg-main)
diff --git a/src/Makefile.in b/src/Makefile.in
index d9874104327..c0494e4edd0 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -556,6 +556,9 @@ dmpstruct.h:
$(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \
$(dmpstruct_headers) > $@
+igc-generated.c: ../admin/igc-codegen.el
+ $(AM_V_GEN) emacs --batch -l $< -f igccg-main > $@
+
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
ifeq ($(AUTO_DEPEND),yes)
diff --git a/src/igc.c b/src/igc.c
index 541bbd6614e..c94be5aecef 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -47,6 +47,7 @@
#include "termhooks.h"
#include "thread.h"
#include "treesit.h"
+#include "process.h"
#include "puresize.h"
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
@@ -528,9 +529,12 @@ object_nelems (void *client, size_t elem_size)
}
static enum pvec_type
-pseudo_vector_type (const struct Lisp_Vector *v)
+pseudo_vector_type (union vectorlike_header header)
{
- return PSEUDOVECTOR_TYPE (v);
+ ptrdiff_t size = header.size;
+ return (size & PSEUDOVECTOR_FLAG
+ ? (size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS
+ : PVEC_NORMAL_VECTOR);
}
static size_t
@@ -545,7 +549,7 @@ vector_size (const struct Lisp_Vector *v)
static size_t
vector_start (const struct Lisp_Vector *v)
{
- enum pvec_type type = pseudo_vector_type (v);
+ enum pvec_type type = pseudo_vector_type (v->header);
return type == PVEC_SUB_CHAR_TABLE ? SUB_CHAR_TABLE_OFFSET : 0;
}
@@ -718,6 +722,7 @@ scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure)
return MPS_RES_OK;
}
+#if 0
static mps_res_t
fix_fwd (mps_ss_t ss, lispfwd fwd)
{
@@ -750,7 +755,9 @@ fix_fwd (mps_ss_t ss, lispfwd fwd)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
{
@@ -786,6 +793,7 @@ fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
/* This exists because we need access to a threads' current specpdl
pointer, which means we need access to the thread_state, which can
@@ -805,6 +813,139 @@ scan_igc (mps_ss_t ss, void *start, void *end, void *closure)
return MPS_RES_OK;
}
+static mps_res_t
+fix_frame_quirks (mps_ss_t ss, struct frame *f)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f) && FRAME_OUTPUT_DATA (f))
+ {
+ struct font **font_ptr = &FRAME_FONT (f);
+ if (*font_ptr)
+ IGC_FIX12_RAW (ss, font_ptr);
+ Lisp_Object *nle = &FRAME_DISPLAY_INFO (f)->name_list_element;
+ IGC_FIX12_OBJ (ss, nle);
+
+#ifdef HAVE_NS
+ struct ns_display_info *i = FRAME_DISPLAY_INFO (f);
+ IGC_FIX12_RAW (ss, &i->terminal);
+ IGC_FIX12_OBJ (ss, &i->rdb);
+ IGC_FIX12_RAW (ss, &i->highlight_frame);
+ IGC_FIX12_RAW (ss, &i->ns_focus_frame);
+ IGC_FIX12_RAW (ss, &i->last_mouse_motion_frame);
+ struct frame **pf = ns_emacs_view_emacs_frame (f);
+ IGC_FIX12_RAW (ss, pf);
+#endif
+ }
+#endif // HAVE_WINDOW_SYSTEM
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_glyph_matrix (mps_ss_t ss, struct glyph_matrix *matrix)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ struct glyph_row *row = matrix->rows;
+ struct glyph_row *end = row + matrix->nrows;
+
+ for (; row < end; ++row)
+ if (row->enabled_p)
+ for (int area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
+ {
+ struct glyph *glyph = row->glyphs[area];
+ struct glyph *end_glyph = glyph + row->used[area];
+ for (; glyph < end_glyph; ++glyph)
+ IGC_FIX12_OBJ (ss, &glyph->object);
+ }
+ IGC_FIX12_RAW (ss, &matrix->buffer);
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_window_quirks (mps_ss_t ss, struct window *w)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ if (w->current_matrix)
+ IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->current_matrix));
+ if (w->desired_matrix)
+ IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->desired_matrix));
+
+#ifdef HAVE_NS
+ void *pr[4];
+ int n = ns_emacs_scroller_refs (w, pr, ARRAYELTS (pr));
+ for (int i = 0; i < n; ++i)
+ IGC_FIX12_RAW (ss, pr[i]);
+#endif
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_buffer_quirks (mps_ss_t ss, struct buffer *b)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ if (b->base_buffer)
+ b->text = &b->base_buffer->own_text;
+ else
+ b->text = &b->own_text;
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_coding (mps_ss_t ss, struct coding_system *c)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ if (c)
+ {
+ IGC_FIX12_OBJ (ss, &c->src_object);
+ IGC_FIX12_OBJ (ss, &c->dst_object);
+ }
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_terminal_quirks (mps_ss_t ss, struct terminal *t)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ // These are malloc'd, so they can be accessed.
+ IGC_FIX_CALL_FN (ss, struct coding_system, t->keyboard_coding,
+ fix_coding);
+ IGC_FIX_CALL_FN (ss, struct coding_system, t->terminal_coding,
+ fix_coding);
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_font_object_quirks (mps_ss_t ss, struct font *f)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ Lisp_Object const *type = &f->driver->type;
+ IGC_FIX12_OBJ (ss, (Lisp_Object *)type);
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
+#include "igc-generated.c"
+
static mps_res_t
scan_lispsym (mps_ss_t ss, void *start, void *end, void *closure)
{
@@ -1108,6 +1249,7 @@ dflt_skip (mps_addr_t base_addr)
return next;
}
+#if 0
static mps_res_t
fix_string (mps_ss_t ss, struct Lisp_String *s)
{
@@ -1119,7 +1261,9 @@ fix_string (mps_ss_t ss, struct Lisp_String *s)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_interval (mps_ss_t ss, struct interval *iv)
{
@@ -1136,7 +1280,9 @@ fix_interval (mps_ss_t ss, struct interval *iv)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_itree_tree (mps_ss_t ss, struct itree_tree *t)
{
@@ -1148,7 +1294,9 @@ fix_itree_tree (mps_ss_t ss, struct itree_tree *t)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_itree_node (mps_ss_t ss, struct itree_node *n)
{
@@ -1165,7 +1313,9 @@ fix_itree_node (mps_ss_t ss, struct itree_node *n)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_image (mps_ss_t ss, struct image *i)
{
@@ -1182,7 +1332,9 @@ fix_image (mps_ss_t ss, struct image *i)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_image_cache (mps_ss_t ss, struct image_cache *c)
{
@@ -1196,7 +1348,9 @@ fix_image_cache (mps_ss_t ss, struct image_cache *c)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_face (mps_ss_t ss, struct face *f)
{
@@ -1214,7 +1368,9 @@ fix_face (mps_ss_t ss, struct face *f)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_face_cache (mps_ss_t ss, struct face_cache *c)
{
@@ -1227,7 +1383,9 @@ fix_face_cache (mps_ss_t ss, struct face_cache *c)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_ptr_vec (mps_ss_t ss, void *client)
{
@@ -1241,7 +1399,9 @@ fix_ptr_vec (mps_ss_t ss, void *client)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_obj_vec (mps_ss_t ss, Lisp_Object *v)
{
@@ -1254,7 +1414,9 @@ fix_obj_vec (mps_ss_t ss, Lisp_Object *v)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_cons (mps_ss_t ss, struct Lisp_Cons *cons)
{
@@ -1266,7 +1428,9 @@ fix_cons (mps_ss_t ss, struct Lisp_Cons *cons)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv)
{
@@ -1279,7 +1443,9 @@ fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_handler (mps_ss_t ss, struct handler *h)
{
@@ -1294,9 +1460,11 @@ fix_handler (mps_ss_t ss, struct handler *h)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
+#if 0
static mps_res_t
dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
void *closure)
@@ -1341,7 +1509,7 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
break;
case IGC_OBJ_PTR_VEC:
- IGC_FIX_CALL_FN (ss, mps_word_t, client, fix_ptr_vec);
+ IGC_FIX_CALL_FN (ss, void *, client, fix_ptr_vec);
break;
case IGC_OBJ_OBJ_VEC:
@@ -1404,14 +1572,47 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
break;
case IGC_OBJ_BLV:
- IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client,
- fix_blv);
+ IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client, fix_blv);
break;
}
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+
+static mps_res_t
+dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
+ void *closure)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ mps_addr_t base = base_start;
+ mps_addr_t client = base_to_client (base);
+ struct igc_header *header = base;
+
+ if (closure)
+ {
+ struct igc_stats *st = closure;
+ mps_word_t obj_type = header->obj_type;
+ igc_assert (obj_type < IGC_OBJ_NUM_TYPES);
+ st->obj[obj_type].nwords += header->nwords;
+ st->obj[obj_type].nobjs += 1;
+ if (obj_type == IGC_OBJ_VECTOR)
+ {
+ struct Lisp_Vector *v = (struct Lisp_Vector *)client;
+ enum pvec_type pvec_type = pseudo_vector_type (v->header);
+ igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
+ st->pvec[pvec_type].nwords += header->nwords;
+ st->pvec[pvec_type].nobjs += 1;
+ }
+ }
+
+ IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
static mps_res_t
dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
@@ -1421,7 +1622,7 @@ dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
{
for (mps_addr_t base = base_start; base < base_limit;
base = dflt_skip (base))
- IGC_FIX_CALL (ss, dflt_scan_obj (ss, base, base_limit, closure));
+ IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
@@ -1432,7 +1633,9 @@ dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit)
{
MPS_SCAN_BEGIN (ss)
{
- IGC_FIX_CALL (ss, dflt_scanx (ss, base_start, base_limit, NULL));
+ for (mps_addr_t base = base_start; base < base_limit;
+ base = dflt_skip (base))
+ IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
@@ -1450,6 +1653,7 @@ fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
return MPS_RES_OK;
}
+#if 0
static mps_res_t
fix_buffer (mps_ss_t ss, struct buffer *b)
{
@@ -1472,32 +1676,9 @@ fix_buffer (mps_ss_t ss, struct buffer *b)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
-static mps_res_t
-fix_glyph_matrix (mps_ss_t ss, struct glyph_matrix *matrix)
-{
- MPS_SCAN_BEGIN (ss)
- {
- struct glyph_row *row = matrix->rows;
- struct glyph_row *end = row + matrix->nrows;
-
- for (; row < end; ++row)
- if (row->enabled_p)
- {
- for (int area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
- {
- struct glyph *glyph = row->glyphs[area];
- struct glyph *end_glyph = glyph + row->used[area];
- for (; glyph < end_glyph; ++glyph)
- IGC_FIX12_OBJ (ss, &glyph->object);
- }
- }
- IGC_FIX12_RAW (ss, &matrix->buffer);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
+#if 0
static mps_res_t
fix_frame (mps_ss_t ss, struct frame *f)
{
@@ -1514,32 +1695,14 @@ fix_frame (mps_ss_t ss, struct frame *f)
IGC_FIX12_RAW (ss, &f->face_cache);
if (f->terminal)
IGC_FIX12_RAW (ss, &f->terminal);
-#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (f) && FRAME_OUTPUT_DATA (f))
- {
- struct font **font_ptr = &FRAME_FONT (f);
- if (*font_ptr)
- IGC_FIX12_RAW (ss, font_ptr);
- Lisp_Object *nle = &FRAME_DISPLAY_INFO (f)->name_list_element;
- IGC_FIX12_OBJ (ss, nle);
-
-#ifdef HAVE_NS
- struct ns_display_info *i = FRAME_DISPLAY_INFO (f);
- IGC_FIX12_RAW (ss, &i->terminal);
- IGC_FIX12_OBJ (ss, &i->rdb);
- IGC_FIX12_RAW (ss, &i->highlight_frame);
- IGC_FIX12_RAW (ss, &i->ns_focus_frame);
- IGC_FIX12_RAW (ss, &i->last_mouse_motion_frame);
- struct frame **pf = ns_emacs_view_emacs_frame (f);
- IGC_FIX12_RAW (ss, pf);
-#endif
- }
-#endif // HAVE_WINDOW_SYSTEM
+ IGC_FIX_CALL_FN (ss, struct frame, f, fix_frame_quirks);
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_window (mps_ss_t ss, struct window *w)
{
@@ -1569,7 +1732,9 @@ fix_window (mps_ss_t ss, struct window *w)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
{
@@ -1585,9 +1750,11 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
-fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
+fix_char_table (mps_ss_t ss, struct Lisp_Char_Table *v)
{
MPS_SCAN_BEGIN (ss)
{
@@ -1597,7 +1764,23 @@ fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
+static mps_res_t
+fix_sub_char_table (mps_ss_t ss, struct Lisp_Sub_Char_Table *v)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ int size = v->header.size & PSEUDOVECTOR_SIZE_MASK;
+ IGC_FIX12_NOBJS (ss, v->contents, size - SUB_CHAR_TABLE_OFFSET);
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+#endif
+
+#if 0
static mps_res_t
fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o)
{
@@ -1610,7 +1793,9 @@ fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_subr (mps_ss_t ss, struct Lisp_Subr *s)
{
@@ -1628,7 +1813,9 @@ fix_subr (mps_ss_t ss, struct Lisp_Subr *s)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p)
{
@@ -1640,7 +1827,9 @@ fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p)
{
@@ -1652,7 +1841,9 @@ fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_thread (mps_ss_t ss, struct thread_state *s)
{
@@ -1666,6 +1857,7 @@ fix_thread (mps_ss_t ss, struct thread_state *s)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
/* This is here because main_thread is, for some reason, a variable in
the data segment, and not like other threads. */
@@ -1683,6 +1875,7 @@ scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure)
return MPS_RES_OK;
}
+#if 0
static mps_res_t
fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m)
{
@@ -1694,22 +1887,9 @@ fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
-static mps_res_t
-fix_coding (mps_ss_t ss, struct coding_system *c)
-{
- MPS_SCAN_BEGIN (ss)
- {
- if (c)
- {
- IGC_FIX12_OBJ (ss, &c->src_object);
- IGC_FIX12_OBJ (ss, &c->dst_object);
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
+#if 0
static mps_res_t
fix_terminal (mps_ss_t ss, struct terminal *t)
{
@@ -1727,7 +1907,9 @@ fix_terminal (mps_ss_t ss, struct terminal *t)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_marker (mps_ss_t ss, struct Lisp_Marker *m)
{
@@ -1739,7 +1921,9 @@ fix_marker (mps_ss_t ss, struct Lisp_Marker *m)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f)
{
@@ -1752,7 +1936,9 @@ fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
+#if 0
static mps_res_t
fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u)
{
@@ -1768,6 +1954,7 @@ fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
#ifdef HAVE_XWIDGETS
@@ -1812,6 +1999,7 @@ fix_global_ref (mps_ss_t ss, struct module_global_reference *r)
#endif
#ifndef IN_MY_FORK
+#if 0
static mps_res_t
fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o)
{
@@ -1823,7 +2011,9 @@ fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o)
return MPS_RES_OK;
}
#endif
+#endif
+#if 0
static mps_res_t
fix_font (mps_ss_t ss, struct Lisp_Vector *v)
{
@@ -1850,17 +2040,19 @@ fix_font (mps_ss_t ss, struct Lisp_Vector *v)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
/* Note that there is a small window after committing a vectorlike
allocation where the object is zeroed, and so the vector header is
also zero. This doesn't have an adverse effect. */
+#if 0
static mps_res_t
fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
{
MPS_SCAN_BEGIN (ss)
{
- switch (pseudo_vector_type (v))
+ switch (pseudo_vector_type (v->header))
{
#ifndef IN_MY_FORK
case PVEC_OBARRAY:
@@ -1885,8 +2077,12 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
break;
case PVEC_CHAR_TABLE:
+ IGC_FIX_CALL_FN (ss, struct Lisp_Char_Table, v, fix_char_table);
+ break;
+
case PVEC_SUB_CHAR_TABLE:
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table);
+ IGC_FIX_CALL_FN (ss, struct Lisp_Sub_Char_Table, v,
+ fix_sub_char_table);
break;
case PVEC_BOOL_VECTOR:
@@ -1983,6 +2179,7 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
static igc_scan_result_t
scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr)
@@ -2557,7 +2754,7 @@ finalize_finalizer (struct Lisp_Finalizer *f)
static void
finalize_vector (mps_addr_t v)
{
- switch (pseudo_vector_type (v))
+ switch (pseudo_vector_type (((struct Lisp_Vector *)v)->header))
{
case PVEC_FREE:
emacs_abort ();
@@ -3575,7 +3772,9 @@ igc_header_size (void)
static bool
is_builtin_subr (enum igc_obj_type type, void *client)
{
- if (type == IGC_OBJ_VECTOR && pseudo_vector_type (client) == PVEC_SUBR)
+ if (type == IGC_OBJ_VECTOR
+ && pseudo_vector_type (((struct Lisp_Vector *)client)->header)
+ == PVEC_SUBR)
{
Lisp_Object subr = make_lisp_ptr (client, Lisp_Vectorlike);
return !SUBR_NATIVE_COMPILEDP (subr);
@@ -3809,7 +4008,7 @@ record_copy (struct igc_mirror *m, void *dumped, void *copy)
if (h->obj_type == IGC_OBJ_VECTOR)
{
struct Lisp_Vector *v = base_to_client (copy);
- int i = pseudo_vector_type (v);
+ int i = pseudo_vector_type (v->header);
m->pvec[i].n += 1;
m->pvec[i].nbytes += header_nbytes (h);
}
@@ -4281,9 +4480,9 @@ mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r)
#endif
static void
-mirror_vector (struct igc_mirror *m, void *client)
+mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client)
{
- switch (pseudo_vector_type (client))
+ switch (pseudo_vector_type (client->header))
{
#ifndef IN_MY_FORK
case PVEC_OBARRAY:
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-WIP-generate-mirror-code.patch --]
[-- Type: text/x-diff, Size: 30849 bytes --]
From 6c50ae682cd7f78954bab97f72c586acdf92be1f Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Tue, 11 Jun 2024 12:52:42 +0200
Subject: [PATCH 2/5] WIP generate mirror code
---
admin/igc-codegen.el | 379 +++++++++++++++++++++++++++++--------------
src/igc.c | 153 ++++++++++++++---
2 files changed, 385 insertions(+), 147 deletions(-)
diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el
index cefe4111866..6224252e7d7 100644
--- a/admin/igc-codegen.el
+++ b/admin/igc-codegen.el
@@ -3,7 +3,36 @@
(require 'treesit)
(require 'project)
+(defconst igccg--obj-types
+ '(IGC_OBJ_INVALID
+ IGC_OBJ_PAD
+ IGC_OBJ_FWD
+ IGC_OBJ_CONS
+ IGC_OBJ_SYMBOL
+ IGC_OBJ_INTERVAL
+ IGC_OBJ_STRING
+ IGC_OBJ_STRING_DATA
+ IGC_OBJ_VECTOR
+ IGC_OBJ_VECTOR_WEAK
+ IGC_OBJ_ITREE_TREE
+ IGC_OBJ_ITREE_NODE
+ IGC_OBJ_IMAGE
+ IGC_OBJ_IMAGE_CACHE
+ IGC_OBJ_FACE
+ IGC_OBJ_FACE_CACHE
+ IGC_OBJ_FLOAT
+ IGC_OBJ_BLV
+ IGC_OBJ_PTR_VEC
+ IGC_OBJ_OBJ_VEC
+ IGC_OBJ_HANDLER
+ IGC_OBJ_BYTES
+ IGC_OBJ_BUILTIN_SYMBOL
+ IGC_OBJ_BUILTIN_THREAD
+ IGC_OBJ_BUILTIN_SUBR
+ ))
+
(defmacro igccg--define-record (name &rest fields)
+ (declare (indent 1))
(let* ((constructor (intern (format "igccg--make-%s" name)))
(conc-name (intern (format "igccg--%s." name)))
(tag-name (intern (format "igccg--%s" name))))
@@ -43,11 +72,14 @@ igccg--emit-line
(make-string igccg--indent ?\s)
string)))
-(defun igccg--emit-function (rtype name args body)
- (princ (format "static %s\n%s (%s)\n{\n" rtype name (string-join args ", ")))
- (let ((igccg--indent 2))
- (funcall body))
- (princ "}\n\n"))
+(defun igccg--emit-function (spec body)
+ (pcase-exhaustive spec
+ (`[,name ,args ,rtype]
+ (princ (format "static %s\n%s (%s)\n{\n"
+ rtype name (string-join args ", ")))
+ (let ((igccg--indent 2))
+ (funcall body))
+ (princ "}\n\n"))))
(defun igccg--emit-block (body)
(igccg--emit-line "{")
@@ -76,12 +108,6 @@ igccg--ifdef-exp
((guard (symbolp exp)) (format "defined %s" exp))
(`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || "))))
-(defun igccg--emit-scan-body (body)
- (igccg--emit-line "MPS_SCAN_BEGIN (ss)")
- (igccg--emit-block body)
- (igccg--emit-line "MPS_SCAN_END (ss);")
- (igccg--emit-line "return MPS_RES_OK;"))
-
(defun igccg--field-addr-exp (var path)
(pcase-exhaustive path
((guard (symbolp path))
@@ -108,22 +134,15 @@ igccg--field-value-exp
(format "(%s->header.size & PSEUDOVECTOR_SIZE_MASK)\
- SUB_CHAR_TABLE_OFFSET" var))))
-(defun igccg--emit-fix-call (ss type var fname)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, %s, %s, %s);"
- ss (igccg--type-spec type) var fname)))
-
(defun igccg--emit-abort ()
(igccg--emit-line "emacs_abort ();"))
-(defun igccg--emit-fix-field-exp (ss obj exp)
+(defun igccg--emit-fix-field-exp (visitor layout obj exp)
(pcase-exhaustive exp
(`(tagged ,path)
- (igccg--emit-line (format "IGC_FIX12_OBJ (%s, %s);"
- ss (igccg--field-addr-exp obj path))))
+ (igccg--emit-fix-tagged visitor (igccg--field-addr-exp obj path)))
(`(untagged ,path)
- (igccg--emit-line (format "IGC_FIX12_RAW (%s, %s);"
- ss (igccg--field-addr-exp obj path))))
+ (igccg--emit-fix-untagged visitor (igccg--field-addr-exp obj path)))
(`(switch ,path . ,cases)
(igccg--emit-switch
(igccg--field-value-exp obj path)
@@ -132,135 +151,240 @@ igccg--emit-fix-field-exp
(`(,tag . ,fields)
(cons (symbol-name tag)
(lambda ()
- (mapc (lambda (field)
- (igccg--emit-fix-field-exp ss obj field))
+ (mapc (lambda (f)
+ (igccg--emit-fix-field-exp
+ visitor layout obj f))
fields))))))
cases)))
(`(array tagged ,start ,len)
- (igccg--emit-line
- (format (concat "IGC_FIX12_NOBJS (%s, %s, %s);")
- ss
- (igccg--field-value-exp obj start)
- (igccg--field-value-exp obj len))))
+ (igccg--emit-fix-tagged-array visitor
+ (igccg--field-value-exp obj start)
+ (igccg--field-value-exp obj len)))
(`(array untagged ,start ,len)
- (igccg--emit-line
- (format "size_t len = %s;" (igccg--field-value-exp obj len)))
- (igccg--emit-line
- (format "for (void **p = %s, **q = p + len; p < q; p++)"
- (igccg--field-value-exp obj start)))
- (igccg--emit-block (lambda ()
- (igccg--emit-line
- (format "IGC_FIX12_RAW (%s, p);" ss)))))
+ (igccg--emit-fix-untagged-array visitor
+ (igccg--field-value-exp obj start)
+ (igccg--field-value-exp obj len)))
(`(vectorlike)
- (igccg--emit-line
- (format
- "IGC_FIX12_NOBJS (%s,\
- (Lisp_Object *)(&%s->header + 1),\
- %s->header.size & PSEUDOVECTOR_SIZE_MASK);" ss obj obj)))
+ (igccg--emit-fix-tagged-array
+ visitor
+ (format "(Lisp_Object *)(&%s->header + 1)" obj)
+ (format "%s->header.size & PSEUDOVECTOR_SIZE_MASK" obj)))
(`(cfg ,test . ,exps)
(igccg--emit-\#if (igccg--ifdef-exp test)
(lambda ()
(mapc (lambda (exp)
- (igccg--emit-fix-field-exp ss obj exp))
+ (igccg--emit-fix-field-exp
+ visitor layout obj exp))
exps))))
('(abort)
(igccg--emit-abort))
- ('(frame-quirks)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, struct frame, %s, fix_frame_quirks);"
- ss obj)))
- ('(window-quirks)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, struct window, %s, fix_window_quirks);"
- ss obj)))
- ('(buffer-quirks)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, struct buffer, %s, fix_buffer_quirks);"
- ss obj)))
- ('(terminal-quirks)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, struct terminal, %s, fix_terminal_quirks);"
- ss obj)))
- ('(font-object-quirks)
- (igccg--emit-line
- (format "IGC_FIX_CALL_FN (%s, struct font, %s, fix_font_object_quirks);"
- ss obj)))))
-
-(defun igccg--fix-method-name (layout)
- (format "fix_%s" (igccg--layout.name layout)))
+ ('(quirks)
+ (igccg--emit-quirks visitor (igccg--layout.name layout) obj))))
(defun igccg--scan-vectorlike-method-name (prefix)
(format "%s_scan_vectorlike" prefix))
-(defun igccg--emit-fix-method (layout)
+(defun igccg--emit-scan-method (visitor layout)
(igccg--emit-function
- "mps_res_t"
- (igccg--fix-method-name layout)
- (list "mps_ss_t ss" (igccg--arg-decl "o"
- `(* ,(igccg--layout.ctype layout))))
+ (igccg--scan-method-spec visitor "o" layout)
(lambda ()
- (igccg--emit-scan-body
+ (igccg--emit-function-body
+ visitor
(lambda ()
(dolist (exp (igccg--layout.fields layout))
- (igccg--emit-fix-field-exp "ss" "o" exp)))))))
+ (igccg--emit-fix-field-exp visitor layout "o" exp)))))))
-(defun igccg--emit-scan-vectorlike-method (name layouts)
+(defun igccg--emit-scan-vectorlike (visitor layouts)
(igccg--emit-function
- "mps_res_t"
- name
- (list "mps_ss_t ss" "struct Lisp_Vector *v")
+ (igccg--scan-vectorlike-spec visitor)
(lambda ()
- (igccg--emit-scan-body
+ (igccg--emit-function-body
+ visitor
(lambda ()
(igccg--emit-switch
"pseudo_vector_type (v->header)"
(append
(mapcar (lambda (l)
- (cons (symbol-name (igccg--layout.pvectype l))
- (lambda ()
- (igccg--emit-fix-call
- "ss" (igccg--layout.ctype l)
- "v" (igccg--fix-method-name l)))))
+ (cons
+ (symbol-name (igccg--layout.pvectype l))
+ (lambda ()
+ (igccg--emit-call
+ visitor
+ (aref (igccg--scan-method-spec visitor "x" l) 0)
+ "v" (igccg--layout.ctype l)))))
layouts)
(list (cons 'PVEC_FREE (lambda () (igccg--emit-abort)))))))))))
-(defun igccg--emit-scan-object-method (prefix layouts)
- (mapc #'igccg--emit-fix-method layouts)
- (let* ((alist (seq-group-by #'igccg--layout.header igccg--layouts ))
- (vectorlike (cdr (assq 'IGC_OBJ_VECTOR alist)))
- (scan-vectorlike (igccg--scan-vectorlike-method-name prefix)))
- (igccg--emit-scan-vectorlike-method scan-vectorlike vectorlike)
+(cl-defgeneric igccg--scan-object-spec (visitor))
+(cl-defgeneric igccg--scan-vectorlike-spec (visitor))
+(cl-defgeneric igccg--scan-method-spec (visitor var layout))
+(cl-defgeneric igccg--emit-function-body (visitor))
+(cl-defgeneric igccg--emit-call (visitor fname var type))
+(cl-defgeneric igccg--emit-fix-tagged (visitor addr-exp))
+(cl-defgeneric igccg--emit-fix-untagged (visitor addr-exp))
+(cl-defgeneric igccg--emit-fix-tagged-array (visitor start len))
+(cl-defgeneric igccg--emit-fix-untagged-array (visitor start len))
+(cl-defgeneric igccg--emit-quirks (visitor layout obj))
+
+(progn
+ ;; dflt methods
+ (cl-defmethod igccg--scan-object-spec ((v (eql 'dflt)))
+ ["dflt_scan_object" ("mps_ss_t ss" "mps_addr_t base") "mps_res_t"])
+
+ (cl-defmethod igccg--scan-vectorlike-spec ((v (eql 'dflt)))
+ ["fix_vectorlike" ("mps_ss_t ss" "struct Lisp_Vector *v") "mps_res_t"])
+
+ (cl-defmethod igccg--scan-method-spec ((v (eql 'dflt)) var layout)
+ (vector
+ (format "fix_%s" (igccg--layout.name layout))
+ (list "mps_ss_t ss"
+ (igccg--arg-decl var `(* ,(igccg--layout.ctype layout))))
+ "mps_res_t"))
+
+ (cl-defmethod igccg--emit-function-body ((v (eql 'dflt)) body)
+ (igccg--emit-line "MPS_SCAN_BEGIN (ss)")
+ (igccg--emit-block body)
+ (igccg--emit-line "MPS_SCAN_END (ss);")
+ (igccg--emit-line "return MPS_RES_OK;"))
+
+ (cl-defmethod igccg--emit-call ((v (eql 'dflt)) fname var type)
+ (igccg--emit-line (format "IGC_FIX_CALL_FN (ss, %s, %s, %s);"
+ (igccg--type-spec type) var fname)))
+
+ (cl-defmethod igccg--emit-fix-tagged ((v (eql 'dflt)) addr-expr)
+ (igccg--emit-line (format "IGC_FIX12_OBJ (ss, %s);" addr-expr)))
+
+ (cl-defmethod igccg--emit-fix-untagged ((v (eql 'dflt)) addr-expr)
+ (igccg--emit-line (format "IGC_FIX12_RAW (ss, %s);" addr-expr)))
+
+ (cl-defmethod igccg--emit-fix-tagged-array ((v (eql 'dflt)) start len)
+ (igccg--emit-line (format "IGC_FIX12_NOBJS (ss, %s, %s);" start len)))
+
+ (cl-defmethod igccg--emit-fix-untagged-array ((v (eql 'dflt)) start len)
+ (igccg--emit-line (format "IGC_FIX12_NRAW (ss, %s, %s);" start len)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'dflt)) (l (eql 'frame)) obj)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (ss, struct frame, %s, fix_frame_quirks);"
+ obj)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'dflt)) (l (eql 'window)) obj)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (ss, struct window, %s, fix_window_quirks);"
+ obj)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'dflt)) (l (eql 'buffer)) obj)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (ss, struct buffer, %s, fix_buffer_quirks);"
+ obj)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'dflt)) (l (eql 'terminal)) obj)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (ss, struct terminal, %s, fix_terminal_quirks);"
+ obj)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'dflt)) (l (eql 'font)) obj)
+ (igccg--emit-line
+ (format "IGC_FIX_CALL_FN (ss, struct font, %s, fix_font_quirks);"
+ obj)))
+
+ )
+
+(progn
+ ;; mirror methods
+ (cl-defmethod igccg--scan-object-spec ((v (eql 'mirror)))
+ ["mirror_obj" ("struct igc_mirror *m" "mps_addr_t base") "void"])
+
+ (cl-defmethod igccg--scan-vectorlike-spec ((v (eql 'mirror)))
+ ["mirror_vectorlike" ("struct igc_mirror *m" "struct Lisp_Vector *v")
+ "void"])
+
+ (cl-defmethod igccg--scan-method-spec ((v (eql 'mirror)) var layout)
+ (vector
+ (format "mirror_%s" (igccg--layout.name layout))
+ (list "struct igc_mirror *m"
+ (igccg--arg-decl var `(* ,(igccg--layout.ctype layout))))
+ "void"))
+
+ (cl-defmethod igccg--emit-function-body ((v (eql 'mirror)) body)
+ (funcall body))
+
+ (cl-defmethod igccg--emit-call ((v (eql 'mirror)) fname var type)
+ (igccg--emit-line (format "%s (m, (%s)%s);"
+ fname (igccg--type-spec `(* ,type)) var)))
+
+ (cl-defmethod igccg--emit-fix-tagged ((v (eql 'mirror)) addr-expr)
+ (igccg--emit-line (format "mirror_lisp_obj (m, %s);" addr-expr)))
+
+ (cl-defmethod igccg--emit-fix-untagged ((v (eql 'mirror)) addr-expr)
+ (igccg--emit-line (format "mirror_raw (m, (mps_addr_t *)%s);" addr-expr)))
+
+ (cl-defmethod igccg--emit-fix-tagged-array ((v (eql 'mirror)) start len)
+ (igccg--emit-line (format "mirror_nobj (m, %s, %s);" start len)))
+
+ (cl-defmethod igccg--emit-fix-untagged-array ((v (eql 'mirror)) start len)
+ (igccg--emit-line (format "mirror_nraw (m, %s, %s);" start len)))
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'mirror)) l obj)
+ )
+ )
+
+(defun igccg--scan-method-case (visitor obj layout)
+ (cons
+ (symbol-name (igccg--layout.header layout))
+ (lambda ()
+ (igccg--emit-call visitor
+ (aref (igccg--scan-method-spec visitor "o" layout) 0)
+ obj
+ (igccg--layout.ctype layout)))))
+
+
+(defun igccg--scan-method-vectorlike-case (visitor obj)
+ (cons "IGC_OBJ_VECTOR"
+ (lambda ()
+ (igccg--emit-call visitor
+ (aref (igccg--scan-vectorlike-spec visitor) 0)
+ obj
+ '(struct Lisp_Vector)))))
+
+(defun igccg--emit-scan-object-body (visitor layouts)
+ (let* ((alist (seq-group-by #'igccg--layout.header layouts))
+ (pvecs (assq 'IGC_OBJ_VECTOR alist))
+ (nonpvecs (mapcar (lambda (p)
+ (pcase-exhaustive p
+ (`(,_ . (,layout)) layout)))
+ (remq pvecs alist)))
+ (ignored '(IGC_OBJ_FWD IGC_OBJ_PAD))
+ (unhandled (cl-set-difference igccg--obj-types
+ (append (mapcar #'car alist)
+ ignored)))
+ (unhandled (cons 'IGC_OBJ_NUM_TYPES unhandled)))
+ (igccg--emit-line "mps_addr_t client = base_to_client (base);")
+ (igccg--emit-line "struct igc_header *header = base;")
+ (igccg--emit-switch
+ "header->obj_type"
+ (append
+ (mapcar (lambda (layout)
+ (igccg--scan-method-case visitor "client" layout))
+ nonpvecs)
+ (list (igccg--scan-method-vectorlike-case visitor "client"))
+ (mapcar (lambda (type) (cons (symbol-name type) (lambda ())))
+ ignored)
+ (mapcar (lambda (type) (cons (symbol-name type) #'igccg--emit-abort))
+ unhandled)))))
+
+(defun igccg--emit-scan-object (visitor layouts)
+ (mapc (lambda (l) (igccg--emit-scan-method visitor l)) layouts)
+ (let* ((alist (seq-group-by #'igccg--layout.header layouts))
+ (pvecs (cdr (assq 'IGC_OBJ_VECTOR alist))))
+ (igccg--emit-scan-vectorlike visitor pvecs)
(igccg--emit-function
- "mps_res_t"
- (format "%s_scan_object" prefix)
- (list "mps_ss_t ss" "mps_addr_t base")
+ (igccg--scan-object-spec visitor)
(lambda ()
- (igccg--emit-scan-body
+ (igccg--emit-function-body
+ visitor
(lambda ()
- (igccg--emit-line "mps_addr_t client = base_to_client (base);")
- (igccg--emit-line "struct igc_header *header = base;")
- (igccg--emit-switch
- "header->obj_type"
- (append
- (mapcar
- (lambda (p)
- (pcase-exhaustive p
- (`(,type . (,layout))
- (cons (symbol-name type)
- (lambda ()
- (igccg--emit-fix-call
- "ss" (igccg--layout.ctype layout)
- "client" (igccg--fix-method-name layout)))))
- (`(IGC_OBJ_VECTOR . ,_)
- (cons "IGC_OBJ_VECTOR"
- (lambda ()
- (igccg--emit-fix-call "ss" '(struct Lisp_Vector)
- "client" scan-vectorlike))))))
- alist)
- (list
- (cons "IGC_OBJ_FWD" (lambda ()))
- (cons "IGC_OBJ_PAD" (lambda ()))
- (cons "IGC_OBJ_INVALID" (lambda () (igccg--emit-abort))))))))))))
+ (igccg--emit-scan-object-body visitor layouts)))))))
(defvar igccg--layouts
(list
@@ -388,6 +512,10 @@ igccg--layouts
'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike
'(struct Lisp_Vector) '((array tagged contents (path header size))))
+ (igccg--make-layout
+ 'weak_vector 'IGC_OBJ_VECTOR_WEAK 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike
+ '(struct Lisp_Vector) '((array tagged contents (path header size))))
+
(igccg--make-layout
'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike
'(struct Lisp_Bignum) '())
@@ -439,7 +567,7 @@ igccg--layouts
'((vectorlike)
(untagged face_cache)
(untagged terminal)
- (frame-quirks)))
+ (quirks)))
(igccg--make-layout
'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike
@@ -447,7 +575,7 @@ igccg--layouts
'((vectorlike)
(tagged prev_buffers)
(tagged next_buffers)
- (window-quirks)))
+ (quirks)))
(igccg--make-layout
'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike
@@ -459,11 +587,12 @@ igccg--layouts
'(struct buffer)
'((vectorlike)
(untagged (path own_text intervals))
- (untagged (path own_text markers))
+ ;;(untagged (path own_text markers))
+ (tagged (path own_text markers))
(untagged overlays)
(untagged base_buffer)
(tagged undo_list_)
- (buffer-quirks)))
+ (quirks)))
(igccg--make-layout
'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike
@@ -486,7 +615,7 @@ igccg--layouts
(untagged next_terminal)
(cfg HAVE_WINDOW_SYSTEM
(untagged image_cache))
- (terminal-quirks)))
+ (quirks)))
(igccg--make-layout
'window_configuraion 'IGC_OBJ_VECTOR 'PVEC_WINDOW_CONFIGURATION
@@ -611,15 +740,15 @@ igccg--layouts
(switch (pvec-header-size)
(FONT_SPEC_MAX)
(FONT_ENTITY_MAX)
- (FONT_OBJECT_MAX (font-object-quirks))
- (default (abort)))))
- ))
+ (FONT_OBJECT_MAX (quirks))
+ (default (abort)))))))
(defun igccg-main ()
(igccg--emit-line "/* Generated by igc-codegen.el */")
(igccg--emit-line "#pragma GCC diagnostic push")
;;(igccg--emit-line "#pragma GCC diagnostic ignored \"-Wunused-function\"")
- (igccg--emit-scan-object-method "dflt" igccg--layouts)
+ (igccg--emit-scan-object 'dflt igccg--layouts)
+ (igccg--emit-scan-object 'mirror igccg--layouts)
(igccg--emit-line "#pragma GCC diagnostic pop"))
;; (igccg-main)
diff --git a/src/igc.c b/src/igc.c
index c94be5aecef..12d2472bc69 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -675,6 +675,17 @@ #define IGC_FIX12_NOBJS(ss, a, n) \
} \
while (0)
+#define IGC_FIX12_NRAW(ss, a, n) \
+ do \
+ { \
+ mps_res_t res; \
+ MPS_FIX_CALL ((ss), res = fix_raw_array ((ss), (a), (n))); \
+ if (res != MPS_RES_OK) \
+ return res; \
+ } \
+ while (0)
+
+
#define IGC_FIX_CALL(ss, expr) \
do \
{ \
@@ -708,6 +719,18 @@ fix_array (mps_ss_t ss, Lisp_Object *array, size_t n)
return MPS_RES_OK;
}
+static mps_res_t
+fix_raw_array (mps_ss_t ss, mps_addr_t array[], size_t n)
+{
+ MPS_SCAN_BEGIN (ss)
+ {
+ for (size_t i = 0; i < n; ++i)
+ IGC_FIX12_RAW (ss, &array[i]);
+ }
+ MPS_SCAN_END (ss);
+ return MPS_RES_OK;
+}
+
static mps_res_t
scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure)
{
@@ -933,7 +956,7 @@ fix_terminal_quirks (mps_ss_t ss, struct terminal *t)
}
static mps_res_t
-fix_font_object_quirks (mps_ss_t ss, struct font *f)
+fix_font_quirks (mps_ss_t ss, struct font *f)
{
MPS_SCAN_BEGIN (ss)
{
@@ -944,6 +967,31 @@ fix_font_object_quirks (mps_ss_t ss, struct font *f)
return MPS_RES_OK;
}
+
+struct igc_mirror
+{
+ Lisp_Object dump_to_mps;
+ struct
+ {
+ size_t n, nbytes;
+ } objs[IGC_OBJ_NUM_TYPES];
+ struct
+ {
+ size_t n, nbytes;
+ } pvec[PVEC_TAG_MAX + 1];
+ struct
+ {
+ const char *msg;
+ double time;
+ } times[10];
+ int ntimes;
+};
+
+static void mirror_lisp_obj (struct igc_mirror *m, Lisp_Object *pobj);
+static void mirror_raw (struct igc_mirror *m, mps_addr_t *p);
+static void mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n);
+static void mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n);
+
#include "igc-generated.c"
static mps_res_t
@@ -1462,7 +1510,9 @@ fix_handler (mps_ss_t ss, struct handler *h)
}
#endif
+#if 0
static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
+#endif
#if 0
static mps_res_t
@@ -1641,6 +1691,7 @@ dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit)
return MPS_RES_OK;
}
+#if 0
static mps_res_t
fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
{
@@ -1652,6 +1703,7 @@ fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
+#endif
#if 0
static mps_res_t
@@ -1985,6 +2037,7 @@ fix_xwidget_view (mps_ss_t ss, struct xwidget_view *v)
#endif // HAVE_XWIDGETS
#ifdef HAVE_MODULES
+#if 0
static mps_res_t
fix_global_ref (mps_ss_t ss, struct module_global_reference *r)
{
@@ -1997,6 +2050,7 @@ fix_global_ref (mps_ss_t ss, struct module_global_reference *r)
return MPS_RES_OK;
}
#endif
+#endif
#ifndef IN_MY_FORK
#if 0
@@ -3907,24 +3961,6 @@ copy_to_mps (mps_addr_t base)
return copy;
}
-struct igc_mirror
-{
- Lisp_Object dump_to_mps;
- struct
- {
- size_t n, nbytes;
- } objs[IGC_OBJ_NUM_TYPES];
- struct
- {
- size_t n, nbytes;
- } pvec[PVEC_TAG_MAX + 1];
- struct
- {
- const char *msg;
- double time;
- } times[10];
- int ntimes;
-};
static void
record_time (struct igc_mirror *m, const char *msg)
@@ -4125,13 +4161,20 @@ #define IGC_MIRROR_OBJ(m, obj) mirror_lisp_obj ((m), (obj))
#define IGC_MIRROR_RAW(m, pp) mirror_raw ((m), (mps_addr_t *) (pp))
static void
-mirror_array (struct igc_mirror *m, Lisp_Object *array, size_t n)
+mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n)
{
for (size_t i = 0; i < n; ++i)
IGC_MIRROR_OBJ (m, &array[i]);
}
-#define IGC_MIRROR_NOBJS(m, a, n) mirror_array (m, a, n)
+static void
+mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n)
+{
+ for (size_t i = 0; i < n; ++i)
+ mirror_raw (m, &array[i]);
+}
+
+#define IGC_MIRROR_NOBJS(m, a, n) mirror_nobj (m, a, n)
static void
mirror_fwd (struct igc_mirror *m, lispfwd fwd)
@@ -4159,6 +4202,7 @@ mirror_fwd (struct igc_mirror *m, lispfwd fwd)
}
}
+#if 0
static void
mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym)
{
@@ -4189,14 +4233,18 @@ mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym)
break;
}
}
+#endif
+#if 0
static void
mirror_string (struct igc_mirror *m, struct Lisp_String *s)
{
IGC_MIRROR_RAW (m, &s->u.s.data);
IGC_MIRROR_RAW (m, &s->u.s.intervals);
}
+#endif
+#if 0
static void
mirror_interval (struct igc_mirror *m, struct interval *i)
{
@@ -4208,13 +4256,17 @@ mirror_interval (struct igc_mirror *m, struct interval *i)
IGC_MIRROR_RAW (m, &i->up.interval);
IGC_MIRROR_OBJ (m, &i->plist);
}
+#endif
+#if 0
static void
mirror_itree_tree (struct igc_mirror *m, struct itree_tree *t)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_itree_node (struct igc_mirror *m, struct itree_node *n)
{
@@ -4226,37 +4278,49 @@ mirror_itree_node (struct igc_mirror *m, struct itree_node *n)
IGC_MIRROR_RAW (m, &n->right);
IGC_MIRROR_OBJ (m, &n->data);
}
+#endif
+#if 0
static void
mirror_image (struct igc_mirror *m, struct image *i)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_image_cache (struct igc_mirror *m, struct image_cache *c)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_face (struct igc_mirror *m, struct face *f)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_face_cache (struct igc_mirror *m, struct face_cache *c)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_ptr_vec (struct igc_mirror *m, void *p)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_obj_vec (struct igc_mirror *m, Lisp_Object *v)
{
@@ -4264,20 +4328,26 @@ mirror_obj_vec (struct igc_mirror *m, Lisp_Object *v)
for (size_t i = 0; i < n; ++i)
IGC_MIRROR_OBJ (m, &v[i]);
}
+#endif
+#if 0
static void
mirror_handler (struct igc_mirror *m, struct handler *h)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_cons (struct igc_mirror *m, struct Lisp_Cons *c)
{
IGC_MIRROR_OBJ (m, &c->u.s.car);
IGC_MIRROR_OBJ (m, &c->u.s.u.cdr);
}
+#endif
+#if 0
static void
mirror_blv (struct igc_mirror *m, struct Lisp_Buffer_Local_Value *blv)
{
@@ -4285,6 +4355,7 @@ mirror_blv (struct igc_mirror *m, struct Lisp_Buffer_Local_Value *blv)
IGC_MIRROR_OBJ (m, &blv->defcell);
IGC_MIRROR_OBJ (m, &blv->valcell);
}
+#endif
static void
mirror_vectorlike_ (struct igc_mirror *m, struct Lisp_Vector *v)
@@ -4297,13 +4368,16 @@ #define IGC_MIRROR_VECTORLIKE(m, v) \
mirror_vectorlike_ ((m), (struct Lisp_Vector *) (v))
#ifndef IN_MY_FORK
+#if 0
static void
mirror_obarray (struct igc_mirror *m, struct Lisp_Obarray *o)
{
IGC_MIRROR_RAW (m, &o->buckets);
}
#endif
+#endif
+#if 0
static void
mirror_font (struct igc_mirror *m, struct Lisp_Vector *v)
{
@@ -4326,13 +4400,17 @@ mirror_font (struct igc_mirror *m, struct Lisp_Vector *v)
emacs_abort ();
}
}
+#endif
+#if 0
static void
mirror_mutex (struct igc_mirror *m, struct Lisp_Mutex *x)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_buffer (struct igc_mirror *m, struct buffer *b)
{
@@ -4349,7 +4427,9 @@ mirror_buffer (struct igc_mirror *m, struct buffer *b)
IGC_MIRROR_OBJ (m, &b->undo_list_);
}
+#endif
+#if 0
static void
mirror_frame (struct igc_mirror *m, struct frame *f)
{
@@ -4361,7 +4441,9 @@ mirror_frame (struct igc_mirror *m, struct frame *f)
igc_assert (!FRAME_WINDOW_P (f));
#endif
}
+#endif
+#if 0
static void
mirror_window (struct igc_mirror *m, struct window *w)
{
@@ -4371,7 +4453,9 @@ mirror_window (struct igc_mirror *m, struct window *w)
IGC_MIRROR_OBJ (m, &w->prev_buffers);
IGC_MIRROR_OBJ (m, &w->next_buffers);
}
+#endif
+#if 0
static void
mirror_hash_table (struct igc_mirror *m, struct Lisp_Hash_Table *h)
{
@@ -4383,14 +4467,18 @@ mirror_hash_table (struct igc_mirror *m, struct Lisp_Hash_Table *h)
igc_assert (!pdumper_object_p (h->key));
igc_assert (!pdumper_object_p (h->value));
}
+#endif
+#if 0
static void
mirror_char_table (struct igc_mirror *m, struct Lisp_Vector *v)
{
for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i)
IGC_MIRROR_OBJ (m, &v->contents[i]);
}
+#endif
+#if 0
static void
mirror_overlay (struct igc_mirror *m, struct Lisp_Overlay *o)
{
@@ -4398,7 +4486,9 @@ mirror_overlay (struct igc_mirror *m, struct Lisp_Overlay *o)
IGC_MIRROR_OBJ (m, &o->plist);
IGC_MIRROR_RAW (m, &o->interval);
}
+#endif
+#if 0
static void
mirror_subr (struct igc_mirror *m, struct Lisp_Subr *s)
{
@@ -4411,19 +4501,25 @@ mirror_subr (struct igc_mirror *m, struct Lisp_Subr *s)
IGC_MIRROR_OBJ (m, &s->type);
#endif
}
+#endif
+#if 0
static void
mirror_misc_ptr (struct igc_mirror *m, struct Lisp_Misc_Ptr *p)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_user_ptr (struct igc_mirror *m, struct Lisp_User_Ptr *p)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_thread (struct igc_mirror *m, struct thread_state *s)
{
@@ -4432,30 +4528,39 @@ mirror_thread (struct igc_mirror *m, struct thread_state *s)
IGC_MIRROR_RAW (m, &s->next_thread);
IGC_MIRROR_RAW (m, &s->m_handlerlist);
}
+#endif
+#if 0
static void
mirror_terminal (struct igc_mirror *m, struct terminal *t)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_marker (struct igc_mirror *m, struct Lisp_Marker *ma)
{
IGC_MIRROR_RAW (m, &ma->buffer);
}
+#endif
+#if 0
static void
mirror_finalizer (struct igc_mirror *m, struct Lisp_Finalizer *f)
{
IGC_NOT_IMPLEMENTED ();
}
+#endif
+#if 0
static void
mirror_comp_unit (struct igc_mirror *m, struct Lisp_Native_Comp_Unit *u)
{
IGC_MIRROR_VECTORLIKE (m, u);
}
+#endif
#ifdef HAVE_XWIDGETS
static void
@@ -4479,6 +4584,7 @@ mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r)
}
#endif
+#if 0
static void
mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client)
{
@@ -4602,7 +4708,9 @@ mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client)
break;
}
}
+#endif
+#if 0
static void
mirror (struct igc_mirror *m, void *org_base, void *copy_base)
{
@@ -4689,12 +4797,13 @@ mirror (struct igc_mirror *m, void *org_base, void *copy_base)
break;
}
}
+#endif
static void
mirror_references (struct igc_mirror *m)
{
DOHASH (XHASH_TABLE (m->dump_to_mps), org_base, copy_base)
- mirror (m, fixnum_to_pointer (org_base), fixnum_to_pointer (copy_base));
+ mirror_obj (m, fixnum_to_pointer (copy_base));
record_time (m, "Mirror references");
}
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: attachment --]
[-- Type: text/x-diff, Size: 22727 bytes --]
From c25a02f01b68af1af5d7c55ff90542835f291f71 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 13 Jun 2024 08:39:31 +0200
Subject: [PATCH 3/5] Improve code generator
Add a cfg field to the layout description so that we can generate the
needed #ifdefs.
* src/igc.c (mirror_buffer_quirks): New.
* admin/igc-codegen.el (igccg--emit-quirks): Buffers need special
mirroring code.
(igccg--layout.type): Renamed from igccg--layout.header.
(igccg--layout.cfg): New field.
(igccg--layouts): Add cfg expressions for packages and images.
(igccg--emit-switch, igccg--emit-case): Introduce #ifdef cases.
(igccg--field-addr-exp, igccg--emit-scan-method, igccg--scan-vectorlike-case)
(igccg--scan-method-case, igccg--scan-method-vectorlike-case): Emit
conditional code.
(igccg--ifdef-exp): Allow not operator.
---
admin/igc-codegen.el | 252 +++++++++++++++++++++++--------------------
src/igc.c | 9 ++
2 files changed, 146 insertions(+), 115 deletions(-)
diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el
index 6224252e7d7..f9a6c02827a 100644
--- a/admin/igc-codegen.el
+++ b/admin/igc-codegen.el
@@ -47,7 +47,7 @@ igccg--define-record
`(,field nil :read-only t))
fields))))
-(igccg--define-record layout name header pvectype tag ctype fields)
+(igccg--define-record layout name type pvectype tag cfg ctype fields)
(defun igccg--arg-decl (name type)
(pcase-exhaustive type
@@ -87,16 +87,25 @@ igccg--emit-block
(funcall body))
(igccg--emit-line "}"))
+(defun igccg--emit-case (case)
+ (let ((emit-body (lambda (body)
+ (let ((igccg--indent (+ 2 igccg--indent)))
+ (funcall body)
+ (igccg--emit-line "break;")))))
+ (pcase-exhaustive case
+ (`(case ,tag ,body)
+ (igccg--emit-line (format "case %s:" (symbol-name tag)))
+ (funcall emit-body body))
+ (`(default ,body)
+ (igccg--emit-line "default:")
+ (funcall emit-body body))
+ (`(cfg ,cfg ,case)
+ (igccg--emit-\#if (igccg--ifdef-exp cfg)
+ (lambda () (igccg--emit-case case)))))))
+
(defun igccg--emit-switch (exp cases)
(igccg--emit-line (format "switch (%s)" exp))
- (igccg--emit-block (lambda ()
- (dolist (c cases)
- (igccg--emit-line
- (cond ((equal (car c) "default") "default:")
- (t (format "case %s:" (car c)))))
- (let ((igccg--indent (+ 2 igccg--indent)))
- (funcall (cdr c))
- (igccg--emit-line "break;"))))))
+ (igccg--emit-block (lambda () (mapc #'igccg--emit-case cases))))
(defun igccg--emit-\#if (exp body)
(igccg--emit-line (format "#if %s" exp))
@@ -106,7 +115,8 @@ igccg--emit-\#if
(defun igccg--ifdef-exp (exp)
(pcase-exhaustive exp
((guard (symbolp exp)) (format "defined %s" exp))
- (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || "))))
+ (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || "))
+ (`(not ,exp) (format "!(%s)" (igccg--ifdef-exp exp)))))
(defun igccg--field-addr-exp (var path)
(pcase-exhaustive path
@@ -149,12 +159,12 @@ igccg--emit-fix-field-exp
(mapcar (lambda (case)
(pcase-exhaustive case
(`(,tag . ,fields)
- (cons (symbol-name tag)
- (lambda ()
- (mapc (lambda (f)
- (igccg--emit-fix-field-exp
- visitor layout obj f))
- fields))))))
+ `(,@(if (eq tag 'default) `(default) `(case ,tag))
+ ,(lambda ()
+ (mapc (lambda (f)
+ (igccg--emit-fix-field-exp
+ visitor layout obj f))
+ fields))))))
cases)))
(`(array tagged ,start ,len)
(igccg--emit-fix-tagged-array visitor
@@ -185,14 +195,30 @@ igccg--scan-vectorlike-method-name
(format "%s_scan_vectorlike" prefix))
(defun igccg--emit-scan-method (visitor layout)
- (igccg--emit-function
- (igccg--scan-method-spec visitor "o" layout)
- (lambda ()
- (igccg--emit-function-body
- visitor
- (lambda ()
- (dolist (exp (igccg--layout.fields layout))
- (igccg--emit-fix-field-exp visitor layout "o" exp)))))))
+ (let ((f (lambda ()
+ (igccg--emit-function
+ (igccg--scan-method-spec visitor "o" layout)
+ (lambda ()
+ (igccg--emit-function-body
+ visitor
+ (lambda ()
+ (dolist (exp (igccg--layout.fields layout))
+ (igccg--emit-fix-field-exp visitor layout "o" exp)))))))))
+ (cond ((igccg--layout.cfg layout)
+ (igccg--emit-\#if (igccg--ifdef-exp (igccg--layout.cfg layout))
+ f))
+ (t (funcall f)))))
+
+(defun igccg--scan-vectorlike-case (visitor layout)
+ (let ((case `(case ,(igccg--layout.pvectype layout)
+ ,(lambda ()
+ (igccg--emit-call
+ visitor
+ (aref (igccg--scan-method-spec visitor "x" layout) 0)
+ "v" (igccg--layout.ctype layout))))))
+ (cond ((igccg--layout.cfg layout)
+ `(cfg ,(igccg--layout.cfg layout) ,case))
+ (t case))))
(defun igccg--emit-scan-vectorlike (visitor layouts)
(igccg--emit-function
@@ -204,16 +230,9 @@ igccg--emit-scan-vectorlike
(igccg--emit-switch
"pseudo_vector_type (v->header)"
(append
- (mapcar (lambda (l)
- (cons
- (symbol-name (igccg--layout.pvectype l))
- (lambda ()
- (igccg--emit-call
- visitor
- (aref (igccg--scan-method-spec visitor "x" l) 0)
- "v" (igccg--layout.ctype l)))))
+ (mapcar (lambda (l) (igccg--scan-vectorlike-case visitor l))
layouts)
- (list (cons 'PVEC_FREE (lambda () (igccg--emit-abort)))))))))))
+ (list `(case PVEC_FREE ,#'igccg--emit-abort)))))))))
(cl-defgeneric igccg--scan-object-spec (visitor))
(cl-defgeneric igccg--scan-vectorlike-spec (visitor))
@@ -327,28 +346,33 @@ igccg--emit-quirks
(cl-defmethod igccg--emit-quirks ((v (eql 'mirror)) l obj)
)
+
+ (cl-defmethod igccg--emit-quirks ((v (eql 'mirror)) (l (eql 'buffer)) obj)
+ (igccg--emit-line (format "mirror_buffer_quirks (%s);" obj)))
)
(defun igccg--scan-method-case (visitor obj layout)
- (cons
- (symbol-name (igccg--layout.header layout))
- (lambda ()
- (igccg--emit-call visitor
- (aref (igccg--scan-method-spec visitor "o" layout) 0)
- obj
- (igccg--layout.ctype layout)))))
-
+ (let ((case `(case ,(igccg--layout.type layout)
+ ,(lambda ()
+ (igccg--emit-call
+ visitor
+ (aref (igccg--scan-method-spec visitor "o" layout) 0)
+ obj
+ (igccg--layout.ctype layout))))))
+ (cond ((igccg--layout.cfg layout)
+ `(cfg ,(igccg--layout.cfg layout) ,case))
+ (t case))))
(defun igccg--scan-method-vectorlike-case (visitor obj)
- (cons "IGC_OBJ_VECTOR"
- (lambda ()
- (igccg--emit-call visitor
- (aref (igccg--scan-vectorlike-spec visitor) 0)
- obj
+ `(case IGC_OBJ_VECTOR
+ ,(lambda ()
+ (igccg--emit-call visitor
+ (aref (igccg--scan-vectorlike-spec visitor) 0)
+ obj
'(struct Lisp_Vector)))))
(defun igccg--emit-scan-object-body (visitor layouts)
- (let* ((alist (seq-group-by #'igccg--layout.header layouts))
+ (let* ((alist (seq-group-by #'igccg--layout.type layouts))
(pvecs (assq 'IGC_OBJ_VECTOR alist))
(nonpvecs (mapcar (lambda (p)
(pcase-exhaustive p
@@ -368,14 +392,12 @@ igccg--emit-scan-object-body
(igccg--scan-method-case visitor "client" layout))
nonpvecs)
(list (igccg--scan-method-vectorlike-case visitor "client"))
- (mapcar (lambda (type) (cons (symbol-name type) (lambda ())))
- ignored)
- (mapcar (lambda (type) (cons (symbol-name type) #'igccg--emit-abort))
- unhandled)))))
+ (mapcar (lambda (type) `(case ,type ,(lambda ()))) ignored)
+ (mapcar (lambda (type) `(case ,type ,#'igccg--emit-abort)) unhandled)))))
(defun igccg--emit-scan-object (visitor layouts)
(mapc (lambda (l) (igccg--emit-scan-method visitor l)) layouts)
- (let* ((alist (seq-group-by #'igccg--layout.header layouts))
+ (let* ((alist (seq-group-by #'igccg--layout.type layouts))
(pvecs (cdr (assq 'IGC_OBJ_VECTOR alist))))
(igccg--emit-scan-vectorlike visitor pvecs)
(igccg--emit-function
@@ -389,12 +411,12 @@ igccg--emit-scan-object
(defvar igccg--layouts
(list
(igccg--make-layout
- 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons '(struct Lisp_Cons)
+ 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons nil '(struct Lisp_Cons)
'((tagged (path u s car))
(tagged (path u s u cdr))))
(igccg--make-layout
- 'symbol 'IGC_OBJ_SYMBOL nil 'Lisp_Symbol '(struct Lisp_Symbol)
+ 'symbol 'IGC_OBJ_SYMBOL nil 'Lisp_Symbol nil '(struct Lisp_Symbol)
'((tagged (path u s name))
(tagged (path u s function))
(tagged (path u s plist))
@@ -419,7 +441,7 @@ igccg--layouts
->predicate")))))))
(igccg--make-layout
- 'interval 'IGC_OBJ_INTERVAL nil nil '(struct interval)
+ 'interval 'IGC_OBJ_INTERVAL nil nil nil '(struct interval)
'((untagged left)
(untagged right)
(switch up_obj
@@ -428,26 +450,26 @@ igccg--layouts
(tagged plist)))
(igccg--make-layout
- 'string 'IGC_OBJ_STRING nil 'Lisp_String '(struct Lisp_String)
+ 'string 'IGC_OBJ_STRING nil 'Lisp_String nil '(struct Lisp_String)
'((untagged (path u s data))
(untagged (path u s intervals))))
(igccg--make-layout
- 'string_data 'IGC_OBJ_STRING_DATA nil nil '(array uint8_t) nil)
+ 'string_data 'IGC_OBJ_STRING_DATA nil nil nil '(array uint8_t) nil)
(igccg--make-layout
- 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil '(struct itree_tree)
+ 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil nil '(struct itree_tree)
'((untagged root)))
(igccg--make-layout
- 'itree_node 'IGC_OBJ_ITREE_NODE nil nil '(struct itree_node)
+ 'itree_node 'IGC_OBJ_ITREE_NODE nil nil nil '(struct itree_node)
'((untagged parent)
(untagged left)
(untagged right)
(tagged data)))
(igccg--make-layout
- 'image 'IGC_OBJ_IMAGE nil nil '(struct image)
+ 'image 'IGC_OBJ_IMAGE nil nil 'HAVE_WINDOW_SYSTEM '(struct image)
'((tagged spec)
(tagged dependencies)
(tagged lisp_data)
@@ -455,12 +477,13 @@ igccg--layouts
(untagged prev)))
(igccg--make-layout
- 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil '(struct image_cache)
+ 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil 'HAVE_WINDOW_SYSTEM
+ '(struct image_cache)
'((untagged images)
(untagged buckets)))
(igccg--make-layout
- 'face 'IGC_OBJ_FACE nil nil '(struct face)
+ 'face 'IGC_OBJ_FACE nil nil nil '(struct face)
'((array tagged lface "ARRAYELTS (%s->lface)")
(untagged font)
(untagged next)
@@ -471,98 +494,94 @@ igccg--layouts
(untagged extra))))
(igccg--make-layout
- 'face_cache 'IGC_OBJ_FACE_CACHE nil nil '(struct face_cache)
+ 'face_cache 'IGC_OBJ_FACE_CACHE nil nil nil '(struct face_cache)
'((untagged f)
(untagged faces_by_id)
(untagged buckets)))
(igccg--make-layout
- 'float 'IGC_OBJ_FLOAT nil 'Lisp_Float '(struct Lisp_Float)
+ 'float 'IGC_OBJ_FLOAT nil 'Lisp_Float nil '(struct Lisp_Float)
'())
(igccg--make-layout
- 'blv 'IGC_OBJ_BLV nil nil '(struct Lisp_Buffer_Local_Value)
+ 'blv 'IGC_OBJ_BLV nil nil nil '(struct Lisp_Buffer_Local_Value)
'((tagged where)
(tagged defcell)
(tagged valcell)))
- ;; (igccg--make-layout
- ;; 'weak_ref 'IGC_OBJ_WEAK 'Lisp_Vectorlike '(struct Lisp_Weak_Ref)
- ;; '((tagged ref)))
-
(igccg--make-layout
- 'ptr_vec 'IGC_OBJ_PTR_VEC nil nil '(* void)
+ 'ptr_vec 'IGC_OBJ_PTR_VEC nil nil nil '(* void)
'((array untagged "%s" (igc-header-len))))
(igccg--make-layout
- 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil 'Lisp_Object
+ 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil nil 'Lisp_Object
'((array tagged "%s" (igc-header-len))))
(igccg--make-layout
- 'handler 'IGC_OBJ_HANDLER nil nil '(struct handler)
+ 'handler 'IGC_OBJ_HANDLER nil nil nil '(struct handler)
'((tagged tag_or_ch)
(tagged val)
(untagged next)
(untagged nextfree)))
(igccg--make-layout
- 'bytes 'IGC_OBJ_BYTES nil nil '(array uint8_t) nil)
+ 'bytes 'IGC_OBJ_BYTES nil nil nil '(array uint8_t) nil)
(igccg--make-layout
- 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike
+ 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike nil
'(struct Lisp_Vector) '((array tagged contents (path header size))))
(igccg--make-layout
- 'weak_vector 'IGC_OBJ_VECTOR_WEAK 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike
+ 'weak_vector 'IGC_OBJ_VECTOR_WEAK 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike nil
'(struct Lisp_Vector) '((array tagged contents (path header size))))
(igccg--make-layout
- 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike
+ 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike nil
'(struct Lisp_Bignum) '())
(igccg--make-layout
- 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike
+ 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike nil
'(struct Lisp_Marker)
'((untagged buffer)
;;(untagged next)
))
(igccg--make-layout
- 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike
+ 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike nil
'(struct Lisp_Overlay)
'((untagged buffer)
(tagged plist)
(untagged interval)))
(igccg--make-layout
- 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike
+ 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike nil
'(struct Lisp_Finalizer)
'((tagged function)
(untagged next)
(untagged prev)))
(igccg--make-layout
- 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike
+ 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike nil
'(struct Lisp_Symbol_With_Pos)
'((vectorlike)))
(igccg--make-layout
- 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike
+ 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike nil
'(struct Lisp_Misc_Ptr)
'())
(igccg--make-layout
- 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike
+ 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike nil
'(struct Lisp_User_Ptr)
'())
(igccg--make-layout
- 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike
+ 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike nil
'(struct Lisp_Process)
'((vectorlike)))
(igccg--make-layout
- 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike
+ 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike nil
'(struct frame)
'((vectorlike)
(untagged face_cache)
@@ -570,7 +589,7 @@ igccg--layouts
(quirks)))
(igccg--make-layout
- 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike
+ 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike nil
'(struct window)
'((vectorlike)
(tagged prev_buffers)
@@ -578,12 +597,12 @@ igccg--layouts
(quirks)))
(igccg--make-layout
- 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike
+ 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike nil
'(struct Lisp_Bool_Vector)
'())
(igccg--make-layout
- 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike
+ 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike nil
'(struct buffer)
'((vectorlike)
(untagged (path own_text intervals))
@@ -595,7 +614,7 @@ igccg--layouts
(quirks)))
(igccg--make-layout
- 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike
+ 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike nil
'(struct Lisp_Hash_Table)
'((untagged key)
(untagged value)
@@ -604,12 +623,12 @@ igccg--layouts
(untagged index)))
(igccg--make-layout
- 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike
+ 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike '(not IN_MY_FORK)
'(struct Lisp_Obarray)
'((untagged buckets)))
(igccg--make-layout
- 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike
+ 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike nil
'(struct terminal)
'((vectorlike)
(untagged next_terminal)
@@ -619,12 +638,12 @@ igccg--layouts
(igccg--make-layout
'window_configuraion 'IGC_OBJ_VECTOR 'PVEC_WINDOW_CONFIGURATION
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
- 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike
+ 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike nil
'(struct Lisp_Subr)
'((tagged command_modes)
(cfg
@@ -635,22 +654,22 @@ igccg--layouts
(tagged type))))
(igccg--make-layout
- 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike
+ 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike nil
'(struct scroll_bar)
'((vectorlike)))
(igccg--make-layout
- 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike
+ 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
- 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike
+ 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
- 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike
+ 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike nil
'(struct thread_state)
'((vectorlike)
(untagged m_current_buffer)
@@ -658,90 +677,95 @@ igccg--layouts
(untagged m_handlerlist)))
(igccg--make-layout
- 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike
+ 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike nil
'(struct Lisp_Mutex)
'((vectorlike)))
(igccg--make-layout
- 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike
+ 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike nil
'(struct Lisp_CondVar)
'((vectorlike)))
(igccg--make-layout
- 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike
+ 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike nil
'(struct module_global_reference)
'((vectorlike)))
(igccg--make-layout
'module_global_reference 'IGC_OBJ_VECTOR 'PVEC_MODULE_GLOBAL_REFERENCE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
'comp_unit 'IGC_OBJ_VECTOR 'PVEC_NATIVE_COMP_UNIT
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_Native_Comp_Unit)
'((vectorlike)))
(igccg--make-layout
'ts_parser 'IGC_OBJ_VECTOR 'PVEC_TS_PARSER
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_TS_Parser)
'((vectorlike)))
(igccg--make-layout
'ts_node 'IGC_OBJ_VECTOR 'PVEC_TS_NODE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_TS_Node)
'((vectorlike)))
(igccg--make-layout
'ts_query 'IGC_OBJ_VECTOR 'PVEC_TS_COMPILED_QUERY
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_TS_Query)
'((vectorlike)))
(igccg--make-layout
'sqlite 'IGC_OBJ_VECTOR 'PVEC_SQLITE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_Sqlite)
'((vectorlike)))
- ;; (PVEC_WEAK_REF (struct Lisp_Weak_Ref))
-
(igccg--make-layout
'closure 'IGC_OBJ_VECTOR 'PVEC_CLOSURE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
'char_table 'IGC_OBJ_VECTOR 'PVEC_CHAR_TABLE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_Char_Table)
'((vectorlike)))
(igccg--make-layout
'sub_char_table 'IGC_OBJ_VECTOR 'PVEC_SUB_CHAR_TABLE
- 'Lisp_Vectorlike
+ 'Lisp_Vectorlike nil
'(struct Lisp_Sub_Char_Table)
'((array tagged contents (sub-char-table-len))))
(igccg--make-layout
- 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike
+ 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike nil
'vectorlike_header
'((vectorlike)))
(igccg--make-layout
- 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike
+ 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike nil
'(struct Lisp_Vector)
'((vectorlike)
(switch (pvec-header-size)
(FONT_SPEC_MAX)
(FONT_ENTITY_MAX)
(FONT_OBJECT_MAX (quirks))
- (default (abort)))))))
+ (default (abort)))))
+
+ (igccg--make-layout
+ 'package 'IGC_OBJ_VECTOR 'PVEC_PACKAGE 'Lisp_Vectorlike 'IN_MY_FORK
+ 'vectorlike_header
+ '((vectorlike)))
+
+ ))
(defun igccg-main ()
(igccg--emit-line "/* Generated by igc-codegen.el */")
@@ -750,5 +774,3 @@ igccg-main
(igccg--emit-scan-object 'dflt igccg--layouts)
(igccg--emit-scan-object 'mirror igccg--layouts)
(igccg--emit-line "#pragma GCC diagnostic pop"))
-
-;; (igccg-main)
diff --git a/src/igc.c b/src/igc.c
index 12d2472bc69..7f213909677 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -992,6 +992,15 @@ fix_font_quirks (mps_ss_t ss, struct font *f)
static void mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n);
static void mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n);
+static void
+mirror_buffer_quirks (struct buffer *b)
+{
+ if (b->base_buffer)
+ b->text = &b->base_buffer->own_text;
+ else
+ b->text = &b->own_text;
+}
+
#include "igc-generated.c"
static mps_res_t
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Fix-code-genarator.patch --]
[-- Type: text/x-diff, Size: 2424 bytes --]
From 1b1a63d3231d7928ec843d8bdca24cee9bdc6289 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 13 Jun 2024 10:24:53 +0200
Subject: [PATCH 4/5] Fix code genarator
* admin/igc-codegen.el (igccg--obj-types)
(igccg--layouts): Add IGC_OBJ_HASH_VEC.
* src/igc.c (dflt_scanx_obj): Fix nbytes.
---
admin/igc-codegen.el | 10 +++++++++-
src/igc.c | 4 ++--
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el
index f9a6c02827a..e83279dd9c2 100644
--- a/admin/igc-codegen.el
+++ b/admin/igc-codegen.el
@@ -24,6 +24,7 @@ igccg--obj-types
IGC_OBJ_BLV
IGC_OBJ_PTR_VEC
IGC_OBJ_OBJ_VEC
+ IGC_OBJ_HASH_VEC
IGC_OBJ_HANDLER
IGC_OBJ_BYTES
IGC_OBJ_BUILTIN_SYMBOL
@@ -420,7 +421,10 @@ igccg--layouts
'((tagged (path u s name))
(tagged (path u s function))
(tagged (path u s plist))
- (untagged (path u s next))
+ (cfg (not IN_MY_FORK)
+ (untagged (path u s next)))
+ (cfg IN_MY_FORK
+ (tagged (path u s package)))
(switch
(path u s redirect)
(SYMBOL_PLAINVAL (tagged (path u s val value)))
@@ -517,6 +521,10 @@ igccg--layouts
'obj_vec 'IGC_OBJ_OBJ_VEC nil nil nil 'Lisp_Object
'((array tagged "%s" (igc-header-len))))
+ (igccg--make-layout
+ 'hash_vec 'IGC_OBJ_HASH_VEC nil nil nil 'Lisp_Object
+ '((array tagged "%s" (igc-header-len))))
+
(igccg--make-layout
'handler 'IGC_OBJ_HANDLER nil nil nil '(struct handler)
'((tagged tag_or_ch)
diff --git a/src/igc.c b/src/igc.c
index 7f213909677..41d99419dbd 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -1655,14 +1655,14 @@ dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
struct igc_stats *st = closure;
mps_word_t obj_type = header->obj_type;
igc_assert (obj_type < IGC_OBJ_NUM_TYPES);
- st->obj[obj_type].nwords += header->nwords;
+ st->obj[obj_type].nbytes += header_nbytes (header);
st->obj[obj_type].nobjs += 1;
if (obj_type == IGC_OBJ_VECTOR)
{
struct Lisp_Vector *v = (struct Lisp_Vector *)client;
enum pvec_type pvec_type = pseudo_vector_type (v->header);
igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
- st->pvec[pvec_type].nwords += header->nwords;
+ st->pvec[pvec_type].nbytes += header_nbytes (header);
st->pvec[pvec_type].nobjs += 1;
}
}
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Remove-the-code-that-is-now-generated.patch --]
[-- Type: text/x-diff, Size: 45973 bytes --]
From 0ef81303fb6a0cb1b52e0e3483907eb4a02064a7 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Thu, 13 Jun 2024 10:59:39 +0200
Subject: [PATCH 5/5] Remove the code that is now generated
* src/igc.c:
---
src/igc.c | 1824 ++++++-----------------------------------------------
1 file changed, 177 insertions(+), 1647 deletions(-)
diff --git a/src/igc.c b/src/igc.c
index 41d99419dbd..7d16449d6a7 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -745,78 +745,6 @@ scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure)
return MPS_RES_OK;
}
-#if 0
-static mps_res_t
-fix_fwd (mps_ss_t ss, lispfwd fwd)
-{
- MPS_SCAN_BEGIN (ss)
- {
- switch (XFWDTYPE (fwd))
- {
- case Lisp_Fwd_Int:
- case Lisp_Fwd_Bool:
- case Lisp_Fwd_Kboard_Obj:
- break;
-
- case Lisp_Fwd_Obj:
- {
- /* It is not guaranteed that we see all of these when
- scanning staticvec because of DEFVAR_LISP_NOPRO. */
- struct Lisp_Objfwd *o = (void *) fwd.fwdptr;
- IGC_FIX12_OBJ (ss, o->objvar);
- }
- break;
-
- case Lisp_Fwd_Buffer_Obj:
- {
- struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr;
- IGC_FIX12_OBJ (ss, &b->predicate);
- }
- break;
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_OBJ (ss, &sym->u.s.name);
- IGC_FIX12_OBJ (ss, &sym->u.s.function);
- IGC_FIX12_OBJ (ss, &sym->u.s.plist);
-#ifdef IN_MY_FORK
- IGC_FIX12_OBJ (ss, &sym->u.s.package);
-#else
- IGC_FIX12_RAW (ss, &sym->u.s.next);
-#endif
- switch (sym->u.s.redirect)
- {
- case SYMBOL_PLAINVAL:
- IGC_FIX12_OBJ (ss, &sym->u.s.val.value);
- break;
-
- case SYMBOL_VARALIAS:
- IGC_FIX12_RAW (ss, &sym->u.s.val.alias);
- break;
-
- case SYMBOL_LOCALIZED:
- IGC_FIX12_RAW (ss, &sym->u.s.val.blv);
- break;
-
- case SYMBOL_FORWARDED:
- IGC_FIX_CALL (ss, fix_fwd (ss, sym->u.s.val.fwd));
- break;
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
/* This exists because we need access to a threads' current specpdl
pointer, which means we need access to the thread_state, which can
@@ -1306,1055 +1234,221 @@ dflt_skip (mps_addr_t base_addr)
return next;
}
-#if 0
static mps_res_t
-fix_string (mps_ss_t ss, struct Lisp_String *s)
+dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
+ void *closure)
{
MPS_SCAN_BEGIN (ss)
{
- IGC_FIX12_RAW (ss, &s->u.s.data);
- IGC_FIX12_RAW (ss, &s->u.s.intervals);
+ mps_addr_t base = base_start;
+ mps_addr_t client = base_to_client (base);
+ struct igc_header *header = base;
+
+ if (closure)
+ {
+ struct igc_stats *st = closure;
+ mps_word_t obj_type = header->obj_type;
+ igc_assert (obj_type < IGC_OBJ_NUM_TYPES);
+ st->obj[obj_type].nbytes += header_nbytes (header);
+ st->obj[obj_type].nobjs += 1;
+ if (obj_type == IGC_OBJ_VECTOR)
+ {
+ struct Lisp_Vector *v = (struct Lisp_Vector *)client;
+ enum pvec_type pvec_type = pseudo_vector_type (v->header);
+ igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
+ st->pvec[pvec_type].nbytes += header_nbytes (header);
+ st->pvec[pvec_type].nobjs += 1;
+ }
+ }
+
+ IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
static mps_res_t
-fix_interval (mps_ss_t ss, struct interval *iv)
+dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
+ void *closure)
{
MPS_SCAN_BEGIN (ss)
{
- IGC_FIX12_RAW (ss, &iv->left);
- IGC_FIX12_RAW (ss, &iv->right);
- if (iv->up_obj)
- IGC_FIX12_OBJ (ss, &iv->up.obj);
- else if (iv->up.interval)
- IGC_FIX12_RAW (ss, &iv->up.interval);
- IGC_FIX12_OBJ (ss, &iv->plist);
+ for (mps_addr_t base = base_start; base < base_limit;
+ base = dflt_skip (base))
+ IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
static mps_res_t
-fix_itree_tree (mps_ss_t ss, struct itree_tree *t)
+dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit)
{
MPS_SCAN_BEGIN (ss)
{
- if (t->root)
- IGC_FIX12_RAW (ss, &t->root);
+ for (mps_addr_t base = base_start; base < base_limit;
+ base = dflt_skip (base))
+ IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
+/* This is here because main_thread is, for some reason, a variable in
+ the data segment, and not like other threads. */
+
static mps_res_t
-fix_itree_node (mps_ss_t ss, struct itree_node *n)
+scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure)
{
+ igc_assert (start == (void *) &main_thread);
MPS_SCAN_BEGIN (ss)
{
- if (n->parent)
- IGC_FIX12_RAW (ss, &n->parent);
- if (n->left)
- IGC_FIX12_RAW (ss, &n->left);
- if (n->right)
- IGC_FIX12_RAW (ss, &n->right);
- IGC_FIX12_OBJ (ss, &n->data);
+ struct thread_state *s = start;
+ IGC_FIX_CALL (ss, fix_thread (ss, s));
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
+#ifdef HAVE_XWIDGETS
+
static mps_res_t
-fix_image (mps_ss_t ss, struct image *i)
+fix_xwidget (mps_ss_t ss, struct xwidget *w)
{
MPS_SCAN_BEGIN (ss)
{
-#ifdef HAVE_WINDOW_SYSTEM
- IGC_FIX12_OBJ (ss, &i->spec);
- IGC_FIX12_OBJ (ss, &i->dependencies);
- IGC_FIX12_OBJ (ss, &i->lisp_data);
- IGC_FIX12_RAW (ss, &i->next);
- IGC_FIX12_RAW (ss, &i->prev);
-#endif
+ IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike);
+ igc_assert (!"xwidget");
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
static mps_res_t
-fix_image_cache (mps_ss_t ss, struct image_cache *c)
+fix_xwidget_view (mps_ss_t ss, struct xwidget_view *v)
{
MPS_SCAN_BEGIN (ss)
{
-#ifdef HAVE_WINDOW_SYSTEM
- IGC_FIX12_RAW (ss, &c->images);
- IGC_FIX12_RAW (ss, &c->buckets);
-#endif
+ IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike);
+ igc_assert (!"xwidget_view");
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
-static mps_res_t
-fix_face (mps_ss_t ss, struct face *f)
+#endif // HAVE_XWIDGETS
+
+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_NOBJS (ss, f->lface, ARRAYELTS (f->lface));
- IGC_FIX12_RAW (ss, &f->font);
- IGC_FIX12_RAW (ss, &f->next);
- IGC_FIX12_RAW (ss, &f->prev);
- IGC_FIX12_RAW (ss, &f->ascii_face);
-#if defined HAVE_XFT || defined HAVE_FREETYPE
- IGC_FIX12_RAW (ss, &f->extra);
-#endif
+ IGC_FIX12_OBJ (ss, addr);
}
MPS_SCAN_END (ss);
return MPS_RES_OK;
}
-#endif
-#if 0
-static mps_res_t
-fix_face_cache (mps_ss_t ss, struct face_cache *c)
+#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, void *closure, bool ambig)
{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_RAW (ss, &c->f);
- IGC_FIX12_RAW (ss, &c->faces_by_id);
- IGC_FIX12_RAW (ss, &c->buckets);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ mps_root_t root;
+ mps_res_t res
+ = 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);
}
-#endif
-#if 0
-static mps_res_t
-fix_ptr_vec (mps_ss_t ss, void *client)
+static igc_root_list *
+root_create_ambig (struct igc *gc, void *start, void *end)
{
- MPS_SCAN_BEGIN (ss)
- {
- void **v = client;
- size_t n = object_nelems (client, sizeof *v);
- for (size_t i = 0; i < n; ++i)
- IGC_FIX12_RAW (ss, &v[i]);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ return root_create (gc, start, end, mps_rank_ambig (), scan_ambig, NULL,
+ true);
}
-#endif
-#if 0
-static mps_res_t
-fix_obj_vec (mps_ss_t ss, Lisp_Object *v)
+static igc_root_list *
+root_create_exact (struct igc *gc, void *start, void *end,
+ mps_area_scan_t scan)
{
- MPS_SCAN_BEGIN (ss)
- {
- size_t n = object_nelems (v, sizeof *v);
- for (size_t i = 0; i < n; ++i)
- IGC_FIX12_OBJ (ss, &v[i]);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ return root_create (gc, start, end, mps_rank_exact (), scan, NULL, false);
}
-#endif
-#if 0
-static mps_res_t
-fix_cons (mps_ss_t ss, struct Lisp_Cons *cons)
+static void
+root_create_staticvec (struct igc *gc)
{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_OBJ (ss, &cons->u.s.car);
- IGC_FIX12_OBJ (ss, &cons->u.s.u.cdr);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ root_create_exact (gc, staticvec, staticvec + ARRAYELTS (staticvec),
+ scan_staticvec);
}
-#endif
-#if 0
-static mps_res_t
-fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv)
+static void
+root_create_lispsym (struct igc *gc)
{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_OBJ (ss, &blv->where);
- IGC_FIX12_OBJ (ss, &blv->defcell);
- IGC_FIX12_OBJ (ss, &blv->valcell);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym), scan_lispsym);
}
-#endif
-#if 0
-static mps_res_t
-fix_handler (mps_ss_t ss, struct handler *h)
+static void
+root_create_buffer (struct igc *gc, struct buffer *b)
{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_OBJ (ss, &h->tag_or_ch);
- IGC_FIX12_OBJ (ss, &h->val);
- IGC_FIX12_RAW (ss, &h->next);
- IGC_FIX12_RAW (ss, &h->nextfree);
- // FIXME: What about bytecode_top?
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
+ void *start = &b->name_, *end = &b->own_text;
+ root_create_ambig (gc, start, end);
}
-#endif
-
-#if 0
-static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
-#endif
-#if 0
-static mps_res_t
-dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
- void *closure)
+static void
+root_create_terminal_list (struct igc *gc)
{
- MPS_SCAN_BEGIN (ss)
- {
- mps_addr_t base = base_start;
- mps_addr_t client = base_to_client (base);
- struct igc_header *header = base;
+ void *start = &terminal_list;
+ void *end = (char *) start + sizeof (terminal_list);
+ root_create_ambig (gc, start, end);
+}
- if (closure)
- {
- struct igc_stats *st = closure;
- mps_word_t obj_type = header->obj_type;
- igc_assert (obj_type < IGC_OBJ_NUM_TYPES);
- st->obj[obj_type].nbytes += header_nbytes (header);
- st->obj[obj_type].nobjs += 1;
- if (obj_type == IGC_OBJ_VECTOR)
- {
- struct Lisp_Vector* v = (struct Lisp_Vector*) client;
- enum pvec_type pvec_type = pseudo_vector_type (v);
- igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
- st->pvec[pvec_type].nbytes += header_nbytes (header);
- st->pvec[pvec_type].nobjs += 1;
- }
- }
+static void
+root_create_main_thread (struct igc *gc)
+{
+ void *start = &main_thread;
+ void *end = (char *) &main_thread + sizeof (main_thread);
+ root_create_exact (gc, start, end, scan_main_thread);
+}
- switch (header->obj_type)
- {
- case IGC_OBJ_INVALID:
- case IGC_OBJ_BUILTIN_SYMBOL:
- case IGC_OBJ_BUILTIN_THREAD:
- case IGC_OBJ_BUILTIN_SUBR:
- emacs_abort ();
-
- case IGC_OBJ_PAD:
- case IGC_OBJ_FWD:
- continue;
+void
+igc_root_create_ambig (void *start, void *end)
+{
+ root_create_ambig (global_igc, start, end);
+}
- case IGC_OBJ_HANDLER:
- IGC_FIX_CALL_FN (ss, struct handler, client, fix_handler);
- break;
+void
+igc_root_create_exact (Lisp_Object *start, Lisp_Object *end)
+{
+ root_create_exact (global_igc, start, end, scan_exact);
+}
- case IGC_OBJ_PTR_VEC:
- IGC_FIX_CALL_FN (ss, void *, client, fix_ptr_vec);
- break;
+void
+igc_root_create_exact_ptr (void *var_addr)
+{
+ void *start = var_addr;
+ void *end = (char *) start + sizeof (void *);
+ root_create_exact (global_igc, start, end, scan_ptr_exact);
+}
- case IGC_OBJ_OBJ_VEC:
- case IGC_OBJ_HASH_VEC:
- IGC_FIX_CALL_FN (ss, Lisp_Object, client, fix_obj_vec);
- break;
-
- case IGC_OBJ_CONS:
- IGC_FIX_CALL_FN (ss, struct Lisp_Cons, client, fix_cons);
- break;
-
- case IGC_OBJ_STRING_DATA:
- case IGC_OBJ_FLOAT:
- case IGC_OBJ_BYTES:
- /* Can occur in the dump. */
- break;
-
- case IGC_OBJ_NUM_TYPES:
- emacs_abort ();
-
- case IGC_OBJ_SYMBOL:
- IGC_FIX_CALL_FN (ss, struct Lisp_Symbol, client, fix_symbol);
- break;
-
- case IGC_OBJ_INTERVAL:
- IGC_FIX_CALL_FN (ss, struct interval, client, fix_interval);
- break;
-
- case IGC_OBJ_STRING:
- IGC_FIX_CALL_FN (ss, struct Lisp_String, client, fix_string);
- break;
-
- case IGC_OBJ_VECTOR:
- case IGC_OBJ_VECTOR_WEAK:
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, client, fix_vector);
- break;
-
- case IGC_OBJ_ITREE_TREE:
- IGC_FIX_CALL_FN (ss, struct itree_tree, client, fix_itree_tree);
- break;
-
- case IGC_OBJ_ITREE_NODE:
- IGC_FIX_CALL_FN (ss, struct itree_node, client, fix_itree_node);
- break;
-
- case IGC_OBJ_IMAGE:
- IGC_FIX_CALL_FN (ss, struct image, client, fix_image);
- break;
-
- case IGC_OBJ_IMAGE_CACHE:
- IGC_FIX_CALL_FN (ss, struct image_cache, client, fix_image_cache);
- break;
-
- case IGC_OBJ_FACE:
- IGC_FIX_CALL_FN (ss, struct face, client, fix_face);
- break;
-
- case IGC_OBJ_FACE_CACHE:
- IGC_FIX_CALL_FN (ss, struct face_cache, client, fix_face_cache);
- break;
-
- case IGC_OBJ_BLV:
- IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client, fix_blv);
- break;
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-static mps_res_t
-dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
- void *closure)
-{
- MPS_SCAN_BEGIN (ss)
- {
- mps_addr_t base = base_start;
- mps_addr_t client = base_to_client (base);
- struct igc_header *header = base;
-
- if (closure)
- {
- struct igc_stats *st = closure;
- mps_word_t obj_type = header->obj_type;
- igc_assert (obj_type < IGC_OBJ_NUM_TYPES);
- st->obj[obj_type].nbytes += header_nbytes (header);
- st->obj[obj_type].nobjs += 1;
- if (obj_type == IGC_OBJ_VECTOR)
- {
- struct Lisp_Vector *v = (struct Lisp_Vector *)client;
- enum pvec_type pvec_type = pseudo_vector_type (v->header);
- igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX);
- st->pvec[pvec_type].nbytes += header_nbytes (header);
- st->pvec[pvec_type].nobjs += 1;
- }
- }
-
- IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-static mps_res_t
-dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
- void *closure)
-{
- MPS_SCAN_BEGIN (ss)
- {
- for (mps_addr_t base = base_start; base < base_limit;
- base = dflt_skip (base))
- IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure));
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-static mps_res_t
-dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit)
-{
- MPS_SCAN_BEGIN (ss)
- {
- for (mps_addr_t base = base_start; base < base_limit;
- base = dflt_skip (base))
- IGC_FIX_CALL (ss, dflt_scan_object (ss, base));
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-#if 0
-static mps_res_t
-fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- size_t size = vector_size (v);
- IGC_FIX12_NOBJS (ss, v->contents, size);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_buffer (mps_ss_t ss, struct buffer *b)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, b, fix_vectorlike);
- IGC_FIX12_RAW (ss, &b->own_text.intervals);
- IGC_FIX12_OBJ (ss, &b->own_text.markers);
- IGC_FIX12_RAW (ss, &b->overlays);
-
- IGC_FIX12_RAW (ss, &b->base_buffer);
- if (b->base_buffer)
- b->text = &b->base_buffer->own_text;
- else
- b->text = &b->own_text;
-
- // FIXME: special handling of undo_list?
- IGC_FIX12_OBJ (ss, &b->undo_list_);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_frame (mps_ss_t ss, struct frame *f)
-{
- MPS_SCAN_BEGIN (ss)
- {
- // FIXME
- // output_data;
- // terminal
- // glyph_pool
- // glyph matrices
- // struct font_driver_list *font_driver_list;
- // struct text_conversion_state conversion;
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, f, fix_vectorlike);
- IGC_FIX12_RAW (ss, &f->face_cache);
- if (f->terminal)
- IGC_FIX12_RAW (ss, &f->terminal);
- IGC_FIX_CALL_FN (ss, struct frame, f, fix_frame_quirks);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_window (mps_ss_t ss, struct window *w)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike);
- if (w->current_matrix)
- IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->current_matrix));
- if (w->desired_matrix)
- IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->desired_matrix));
-
- /* FIXME: The following two are handled specially in the old GC:
- Both are lists from which entries for non-live buffers are
- removed (mark_window -> mark_discard_killed_buffers).
- So, they are kind of weak lists. I think this could be done
- from a timer. */
- IGC_FIX12_OBJ (ss, &w->prev_buffers);
- IGC_FIX12_OBJ (ss, &w->next_buffers);
-
-#ifdef HAVE_NS
- void *pr[4];
- int n = ns_emacs_scroller_refs (w, pr, ARRAYELTS (pr));
- for (int i = 0; i < n; ++i)
- IGC_FIX12_RAW (ss, pr[i]);
-#endif
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
-{
- MPS_SCAN_BEGIN (ss)
- {
- // FIXME: weak
- IGC_FIX12_RAW (ss, &h->key);
- IGC_FIX12_RAW (ss, &h->value);
- IGC_FIX12_RAW (ss, &h->hash);
- IGC_FIX12_RAW (ss, &h->next);
- IGC_FIX12_RAW (ss, &h->index);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_char_table (mps_ss_t ss, struct Lisp_Char_Table *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i)
- IGC_FIX12_OBJ (ss, &v->contents[i]);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_sub_char_table (mps_ss_t ss, struct Lisp_Sub_Char_Table *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- int size = v->header.size & PSEUDOVECTOR_SIZE_MASK;
- IGC_FIX12_NOBJS (ss, v->contents, size - SUB_CHAR_TABLE_OFFSET);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_RAW (ss, &o->buffer);
- IGC_FIX12_OBJ (ss, &o->plist);
- IGC_FIX12_RAW (ss, &o->interval);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_subr (mps_ss_t ss, struct Lisp_Subr *s)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_OBJ (ss, &s->command_modes);
-#ifdef HAVE_NATIVE_COMP
- IGC_FIX12_OBJ (ss, &s->intspec.native);
- IGC_FIX12_OBJ (ss, &s->command_modes);
- IGC_FIX12_OBJ (ss, &s->native_comp_u);
- IGC_FIX12_OBJ (ss, &s->lambda_list);
- IGC_FIX12_OBJ (ss, &s->type);
-#endif
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, p, fix_vectorlike);
- IGC_FIX12_RAW (ss, &p->pointer);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, p, fix_vectorlike);
- IGC_FIX12_RAW (ss, &p->p);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_thread (mps_ss_t ss, struct thread_state *s)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, s, fix_vectorlike);
- IGC_FIX12_RAW (ss, &s->m_current_buffer);
- IGC_FIX12_RAW (ss, &s->next_thread);
- IGC_FIX12_RAW (ss, &s->m_handlerlist);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-/* This is here because main_thread is, for some reason, a variable in
- the data segment, and not like other threads. */
-
-static mps_res_t
-scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure)
-{
- igc_assert (start == (void *) &main_thread);
- MPS_SCAN_BEGIN (ss)
- {
- struct thread_state *s = start;
- IGC_FIX_CALL (ss, fix_thread (ss, s));
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-#if 0
-static mps_res_t
-fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, m, fix_vectorlike);
- IGC_FIX12_RAW (ss, &m->name);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_terminal (mps_ss_t ss, struct terminal *t)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, t, fix_vectorlike);
- IGC_FIX12_RAW (ss, &t->next_terminal);
-#ifdef HAVE_WINDOW_SYSTEM
- IGC_FIX12_RAW (ss, &t->image_cache);
-#endif
- // These are malloc'd, so they can be accessed.
- IGC_FIX_CALL_FN (ss, struct coding_system, t->keyboard_coding, fix_coding);
- IGC_FIX_CALL_FN (ss, struct coding_system, t->terminal_coding, fix_coding);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_marker (mps_ss_t ss, struct Lisp_Marker *m)
-{
- MPS_SCAN_BEGIN (ss)
- {
- if (m->buffer)
- IGC_FIX12_RAW (ss, &m->buffer);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, f, fix_vectorlike);
- IGC_FIX12_RAW (ss, &f->next);
- IGC_FIX12_RAW (ss, &f->prev);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#if 0
-static mps_res_t
-fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, u, fix_vectorlike);
- /* FIXME: Cannot scan things within the shared object because we
- don't have exclusive (synchronized) access to them. Instead of
- storing Lisp_Object references in vectors in the dylib data
- segment it would be much nicer to store them in MPS and give
- the dylib a pointer to them. */
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-#ifdef HAVE_XWIDGETS
-
-static mps_res_t
-fix_xwidget (mps_ss_t ss, struct xwidget *w)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, w, fix_vectorlike);
- igc_assert (!"xwidget");
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-static mps_res_t
-fix_xwidget_view (mps_ss_t ss, struct xwidget_view *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike);
- igc_assert (!"xwidget_view");
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-
-#endif // HAVE_XWIDGETS
-
-#ifdef HAVE_MODULES
-#if 0
-static mps_res_t
-fix_global_ref (mps_ss_t ss, struct module_global_reference *r)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, r, fix_vectorlike);
- IGC_FIX12_OBJ (ss, &r->value.v);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-#endif
-
-#ifndef IN_MY_FORK
-#if 0
-static mps_res_t
-fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX12_RAW (ss, &o->buckets);
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-#endif
-
-#if 0
-static mps_res_t
-fix_font (mps_ss_t ss, struct Lisp_Vector *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike);
- /* See font.h for the magic numbers. */
- switch (vector_size (v))
- {
- case FONT_SPEC_MAX:
- case FONT_ENTITY_MAX:
- break;
- case FONT_OBJECT_MAX:
- {
- struct font *f = (struct font *)v;
- const Lisp_Object *type = &f->driver->type;
- IGC_FIX12_OBJ (ss, igc_const_cast (Lisp_Object *, type));
- }
- break;
- default:
- emacs_abort ();
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-/* Note that there is a small window after committing a vectorlike
- allocation where the object is zeroed, and so the vector header is
- also zero. This doesn't have an adverse effect. */
-
-#if 0
-static mps_res_t
-fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
-{
- MPS_SCAN_BEGIN (ss)
- {
- switch (pseudo_vector_type (v->header))
- {
-#ifndef IN_MY_FORK
- case PVEC_OBARRAY:
- IGC_FIX_CALL_FN (ss, struct Lisp_Obarray, v, fix_obarray);
- break;
-#endif
-
- case PVEC_BUFFER:
- IGC_FIX_CALL_FN (ss, struct buffer, v, fix_buffer);
- break;
-
- case PVEC_FRAME:
- IGC_FIX_CALL_FN (ss, struct frame, v, fix_frame);
- break;
-
- case PVEC_WINDOW:
- IGC_FIX_CALL_FN (ss, struct window, v, fix_window);
- break;
-
- case PVEC_HASH_TABLE:
- IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
- break;
-
- case PVEC_CHAR_TABLE:
- IGC_FIX_CALL_FN (ss, struct Lisp_Char_Table, v, fix_char_table);
- break;
-
- case PVEC_SUB_CHAR_TABLE:
- IGC_FIX_CALL_FN (ss, struct Lisp_Sub_Char_Table, v,
- fix_sub_char_table);
- break;
-
- case PVEC_BOOL_VECTOR:
- break;
-
- case PVEC_OVERLAY:
- IGC_FIX_CALL_FN (ss, struct Lisp_Overlay, v, fix_overlay);
- break;
-
- case PVEC_SUBR:
- IGC_FIX_CALL_FN (ss, struct Lisp_Subr, v, fix_subr);
- break;
-
- case PVEC_FREE:
- emacs_abort ();
-
- case PVEC_FINALIZER:
- IGC_FIX_CALL_FN (ss, struct Lisp_Finalizer, v, fix_finalizer);
- break;
-
- case PVEC_MISC_PTR:
- IGC_FIX_CALL_FN (ss, struct Lisp_Misc_Ptr, v, fix_misc_ptr);
- break;
-
- case PVEC_USER_PTR:
- IGC_FIX_CALL_FN (ss, struct Lisp_User_Ptr, v, fix_user_ptr);
- break;
-
-#ifdef HAVE_XWIDGETS
- case PVEC_XWIDGET:
- IGC_FIX_CALL_FN (ss, struct xwidget, v, fix_xwidget);
- break;
-
- case PVEC_XWIDGET_VIEW:
- IGC_FIX_CALL_FN (ss, struct xwidget_view, v, fix_xwidget_view);
- break;
-#endif
-
- case PVEC_THREAD:
- IGC_FIX_CALL_FN (ss, struct thread_state, v, fix_thread);
- break;
-
- case PVEC_MUTEX:
- IGC_FIX_CALL_FN (ss, struct Lisp_Mutex, v, fix_mutex);
- break;
-
- case PVEC_TERMINAL:
- IGC_FIX_CALL_FN (ss, struct terminal, v, fix_terminal);
- break;
-
- case PVEC_MARKER:
- IGC_FIX_CALL_FN (ss, struct Lisp_Marker, v, fix_marker);
- break;
-
- case PVEC_BIGNUM:
- break;
-
- case PVEC_NATIVE_COMP_UNIT:
- IGC_FIX_CALL_FN (ss, struct Lisp_Native_Comp_Unit, v, fix_comp_unit);
- break;
-
- case PVEC_MODULE_GLOBAL_REFERENCE:
-#ifdef HAVE_MODULES
- IGC_FIX_CALL_FN (ss, struct module_global_reference, v, fix_global_ref);
-#endif
- break;
-
- case PVEC_FONT:
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_font);
- break;
-
- case PVEC_NORMAL_VECTOR:
- case PVEC_SYMBOL_WITH_POS:
- case PVEC_PROCESS:
- case PVEC_WINDOW_CONFIGURATION:
- case PVEC_XWIDGET:
- case PVEC_XWIDGET_VIEW:
- case PVEC_MODULE_FUNCTION:
- case PVEC_CONDVAR:
- case PVEC_TS_COMPILED_QUERY:
- case PVEC_TS_NODE:
- case PVEC_TS_PARSER:
- case PVEC_SQLITE:
- case PVEC_CLOSURE:
- case PVEC_RECORD:
- case PVEC_OTHER:
-#ifdef IN_MY_FORK
- case PVEC_PACKAGE:
-#endif
- IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_vectorlike);
- break;
- }
- }
- MPS_SCAN_END (ss);
- return MPS_RES_OK;
-}
-#endif
-
-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, void *closure, bool ambig)
-{
- mps_root_t root;
- mps_res_t res
- = 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);
-}
-
-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, NULL,
- true);
-}
-
-static igc_root_list *
-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, NULL, false);
-}
-
-static void
-root_create_staticvec (struct igc *gc)
-{
- root_create_exact (gc, staticvec, staticvec + ARRAYELTS (staticvec),
- scan_staticvec);
-}
-
-static void
-root_create_lispsym (struct igc *gc)
-{
- root_create_exact (gc, lispsym, lispsym + ARRAYELTS (lispsym), scan_lispsym);
-}
-
-static void
-root_create_buffer (struct igc *gc, struct buffer *b)
-{
- void *start = &b->name_, *end = &b->own_text;
- root_create_ambig (gc, start, end);
-}
-
-static void
-root_create_terminal_list (struct igc *gc)
-{
- void *start = &terminal_list;
- void *end = (char *) start + sizeof (terminal_list);
- root_create_ambig (gc, start, end);
-}
-
-static void
-root_create_main_thread (struct igc *gc)
-{
- void *start = &main_thread;
- void *end = (char *) &main_thread + sizeof (main_thread);
- root_create_exact (gc, start, end, scan_main_thread);
-}
-
-void
-igc_root_create_ambig (void *start, void *end)
-{
- root_create_ambig (global_igc, start, end);
-}
-
-void
-igc_root_create_exact (Lisp_Object *start, Lisp_Object *end)
-{
- root_create_exact (global_igc, start, end, scan_exact);
-}
-
-void
-igc_root_create_exact_ptr (void *var_addr)
-{
- void *start = var_addr;
- void *end = (char *) start + sizeof (void *);
- root_create_exact (global_igc, start, end, scan_ptr_exact);
-}
-
-static void
-root_create_specpdl (struct igc_thread_list *t)
-{
- struct igc *gc = t->d.gc;
- struct thread_state *ts = t->d.ts;
- igc_assert (ts->m_specpdl != NULL);
- igc_assert (t->d.specpdl_root == NULL);
- mps_root_t root;
- mps_res_t res
- = mps_root_create_area (&root, gc->arena, mps_rank_exact (), 0,
- ts->m_specpdl, ts->m_specpdl_end, scan_specpdl, t);
- IGC_CHECK_RES (res);
- t->d.specpdl_root
- = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false);
-}
+static void
+root_create_specpdl (struct igc_thread_list *t)
+{
+ struct igc *gc = t->d.gc;
+ struct thread_state *ts = t->d.ts;
+ igc_assert (ts->m_specpdl != NULL);
+ igc_assert (t->d.specpdl_root == NULL);
+ mps_root_t root;
+ mps_res_t res
+ = mps_root_create_area (&root, gc->arena, mps_rank_exact (), 0,
+ ts->m_specpdl, ts->m_specpdl_end, scan_specpdl, t);
+ IGC_CHECK_RES (res);
+ t->d.specpdl_root
+ = register_root (gc, root, ts->m_specpdl, ts->m_specpdl_end, false);
+}
static void
root_create_bc (struct igc_thread_list *t)
@@ -4146,430 +3240,81 @@ mirror_lisp_obj (struct igc_mirror *m, Lisp_Object *pobj)
{
mps_addr_t base = client_to_base (client);
mps_addr_t mirror = lookup_copy (m, base);
- igc_assert (mirror != NULL);
- client = base_to_client (mirror);
- *p = (mps_word_t) client | tag;
- }
- }
-}
-
-static void
-mirror_raw (struct igc_mirror *m, mps_addr_t *p)
-{
- mps_addr_t client = *p;
- if (pdumper_object_p (client))
- {
- mps_addr_t base = client_to_base (client);
- mps_addr_t mirror = lookup_copy (m, base);
- igc_assert (mirror != NULL);
- *p = base_to_client (mirror);
- }
-}
-
-#define IGC_MIRROR_OBJ(m, obj) mirror_lisp_obj ((m), (obj))
-#define IGC_MIRROR_RAW(m, pp) mirror_raw ((m), (mps_addr_t *) (pp))
-
-static void
-mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n)
-{
- for (size_t i = 0; i < n; ++i)
- IGC_MIRROR_OBJ (m, &array[i]);
-}
-
-static void
-mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n)
-{
- for (size_t i = 0; i < n; ++i)
- mirror_raw (m, &array[i]);
-}
-
-#define IGC_MIRROR_NOBJS(m, a, n) mirror_nobj (m, a, n)
-
-static void
-mirror_fwd (struct igc_mirror *m, lispfwd fwd)
-{
- switch (XFWDTYPE (fwd))
- {
- case Lisp_Fwd_Int:
- case Lisp_Fwd_Bool:
- case Lisp_Fwd_Kboard_Obj:
- break;
-
- case Lisp_Fwd_Obj:
- {
- struct Lisp_Objfwd *o = (void *) fwd.fwdptr;
- IGC_MIRROR_OBJ (m, o->objvar);
- }
- break;
-
- case Lisp_Fwd_Buffer_Obj:
- {
- struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr;
- IGC_MIRROR_OBJ (m, &b->predicate);
- }
- break;
- }
-}
-
-#if 0
-static void
-mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym)
-{
- IGC_MIRROR_OBJ (m, &sym->u.s.name);
- IGC_MIRROR_OBJ (m, &sym->u.s.function);
- IGC_MIRROR_OBJ (m, &sym->u.s.plist);
-#ifdef IN_MY_FORK
- IGC_MIRROR_OBJ (m, &sym->u.s.package);
-#else
- IGC_MIRROR_RAW (m, &sym->u.s.next);
-#endif
- switch (sym->u.s.redirect)
- {
- case SYMBOL_PLAINVAL:
- IGC_MIRROR_OBJ (m, &sym->u.s.val.value);
- break;
-
- case SYMBOL_VARALIAS:
- IGC_MIRROR_RAW (m, &sym->u.s.val.alias);
- break;
-
- case SYMBOL_LOCALIZED:
- IGC_MIRROR_RAW (m, &sym->u.s.val.blv);
- break;
-
- case SYMBOL_FORWARDED:
- mirror_fwd (m, sym->u.s.val.fwd);
- break;
- }
-}
-#endif
-
-#if 0
-static void
-mirror_string (struct igc_mirror *m, struct Lisp_String *s)
-{
- IGC_MIRROR_RAW (m, &s->u.s.data);
- IGC_MIRROR_RAW (m, &s->u.s.intervals);
-}
-#endif
-
-#if 0
-static void
-mirror_interval (struct igc_mirror *m, struct interval *i)
-{
- IGC_MIRROR_RAW (m, &i->left);
- IGC_MIRROR_RAW (m, &i->right);
- if (i->up_obj)
- IGC_MIRROR_OBJ (m, &i->up.obj);
- else if (i->up.interval)
- IGC_MIRROR_RAW (m, &i->up.interval);
- IGC_MIRROR_OBJ (m, &i->plist);
-}
-#endif
-
-#if 0
-static void
-mirror_itree_tree (struct igc_mirror *m, struct itree_tree *t)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_itree_node (struct igc_mirror *m, struct itree_node *n)
-{
- if (n->parent)
- IGC_MIRROR_RAW (m, &n->parent);
- if (n->left)
- IGC_MIRROR_RAW (m, &n->left);
- if (n->right)
- IGC_MIRROR_RAW (m, &n->right);
- IGC_MIRROR_OBJ (m, &n->data);
-}
-#endif
-
-#if 0
-static void
-mirror_image (struct igc_mirror *m, struct image *i)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_image_cache (struct igc_mirror *m, struct image_cache *c)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_face (struct igc_mirror *m, struct face *f)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_face_cache (struct igc_mirror *m, struct face_cache *c)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_ptr_vec (struct igc_mirror *m, void *p)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_obj_vec (struct igc_mirror *m, Lisp_Object *v)
-{
- size_t n = object_nelems (v, sizeof *v);
- for (size_t i = 0; i < n; ++i)
- IGC_MIRROR_OBJ (m, &v[i]);
-}
-#endif
-
-#if 0
-static void
-mirror_handler (struct igc_mirror *m, struct handler *h)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_cons (struct igc_mirror *m, struct Lisp_Cons *c)
-{
- IGC_MIRROR_OBJ (m, &c->u.s.car);
- IGC_MIRROR_OBJ (m, &c->u.s.u.cdr);
-}
-#endif
-
-#if 0
-static void
-mirror_blv (struct igc_mirror *m, struct Lisp_Buffer_Local_Value *blv)
-{
- IGC_MIRROR_OBJ (m, &blv->where);
- IGC_MIRROR_OBJ (m, &blv->defcell);
- IGC_MIRROR_OBJ (m, &blv->valcell);
-}
-#endif
-
-static void
-mirror_vectorlike_ (struct igc_mirror *m, struct Lisp_Vector *v)
-{
- ptrdiff_t size = vector_size (v);
- IGC_MIRROR_NOBJS (m, v->contents, size);
-}
-
-#define IGC_MIRROR_VECTORLIKE(m, v) \
- mirror_vectorlike_ ((m), (struct Lisp_Vector *) (v))
-
-#ifndef IN_MY_FORK
-#if 0
-static void
-mirror_obarray (struct igc_mirror *m, struct Lisp_Obarray *o)
-{
- IGC_MIRROR_RAW (m, &o->buckets);
-}
-#endif
-#endif
-
-#if 0
-static void
-mirror_font (struct igc_mirror *m, struct Lisp_Vector *v)
-{
- IGC_MIRROR_VECTORLIKE (m, v);
- switch (vector_size (v))
- {
- case FONT_SPEC_MAX:
- case FONT_ENTITY_MAX:
- break;
-
- case FONT_OBJECT_MAX:
- {
- struct font *f = (struct font *) v;
- Lisp_Object const *type = &f->driver->type;
- IGC_MIRROR_OBJ (m, igc_const_cast (Lisp_Object *, type));
- }
- break;
-
- default:
- emacs_abort ();
- }
-}
-#endif
-
-#if 0
-static void
-mirror_mutex (struct igc_mirror *m, struct Lisp_Mutex *x)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
-
-#if 0
-static void
-mirror_buffer (struct igc_mirror *m, struct buffer *b)
-{
- IGC_MIRROR_VECTORLIKE (m, b);
- IGC_MIRROR_RAW (m, &b->own_text.intervals);
- IGC_MIRROR_OBJ (m, &b->own_text.markers);
- IGC_MIRROR_RAW (m, &b->overlays);
-
- IGC_MIRROR_RAW (m, &b->base_buffer);
- if (b->base_buffer)
- b->text = &b->base_buffer->own_text;
- else
- b->text = &b->own_text;
-
- IGC_MIRROR_OBJ (m, &b->undo_list_);
-}
-#endif
-
-#if 0
-static void
-mirror_frame (struct igc_mirror *m, struct frame *f)
-{
- IGC_MIRROR_VECTORLIKE (m, f);
- IGC_MIRROR_RAW (m, &f->face_cache);
- if (f->terminal)
- IGC_MIRROR_RAW (m, &f->terminal);
-#ifdef HAVE_WINDOW_SYSTEM
- igc_assert (!FRAME_WINDOW_P (f));
-#endif
-}
-#endif
-
-#if 0
-static void
-mirror_window (struct igc_mirror *m, struct window *w)
-{
- IGC_MIRROR_VECTORLIKE (m, w);
- igc_assert (w->current_matrix == NULL);
- igc_assert (w->desired_matrix == NULL);
- IGC_MIRROR_OBJ (m, &w->prev_buffers);
- IGC_MIRROR_OBJ (m, &w->next_buffers);
+ igc_assert (mirror != NULL);
+ client = base_to_client (mirror);
+ *p = (mps_word_t) client | tag;
+ }
+ }
}
-#endif
-#if 0
static void
-mirror_hash_table (struct igc_mirror *m, struct Lisp_Hash_Table *h)
+mirror_raw (struct igc_mirror *m, mps_addr_t *p)
{
- IGC_MIRROR_RAW (m, &h->key);
- IGC_MIRROR_RAW (m, &h->value);
- IGC_MIRROR_RAW (m, &h->hash);
- IGC_MIRROR_RAW (m, &h->next);
- IGC_MIRROR_RAW (m, &h->index);
- igc_assert (!pdumper_object_p (h->key));
- igc_assert (!pdumper_object_p (h->value));
+ mps_addr_t client = *p;
+ if (pdumper_object_p (client))
+ {
+ mps_addr_t base = client_to_base (client);
+ mps_addr_t mirror = lookup_copy (m, base);
+ igc_assert (mirror != NULL);
+ *p = base_to_client (mirror);
+ }
}
-#endif
-#if 0
-static void
-mirror_char_table (struct igc_mirror *m, struct Lisp_Vector *v)
-{
- for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i)
- IGC_MIRROR_OBJ (m, &v->contents[i]);
-}
-#endif
+#define IGC_MIRROR_OBJ(m, obj) mirror_lisp_obj ((m), (obj))
+#define IGC_MIRROR_RAW(m, pp) mirror_raw ((m), (mps_addr_t *) (pp))
-#if 0
static void
-mirror_overlay (struct igc_mirror *m, struct Lisp_Overlay *o)
+mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n)
{
- IGC_MIRROR_RAW (m, &o->buffer);
- IGC_MIRROR_OBJ (m, &o->plist);
- IGC_MIRROR_RAW (m, &o->interval);
+ for (size_t i = 0; i < n; ++i)
+ IGC_MIRROR_OBJ (m, &array[i]);
}
-#endif
-#if 0
static void
-mirror_subr (struct igc_mirror *m, struct Lisp_Subr *s)
+mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n)
{
- IGC_MIRROR_OBJ (m, &s->command_modes);
-#ifdef HAVE_NATIVE_COMP
- IGC_MIRROR_OBJ (m, &s->intspec.native);
- IGC_MIRROR_OBJ (m, &s->command_modes);
- IGC_MIRROR_OBJ (m, &s->native_comp_u);
- IGC_MIRROR_OBJ (m, &s->lambda_list);
- IGC_MIRROR_OBJ (m, &s->type);
-#endif
+ for (size_t i = 0; i < n; ++i)
+ mirror_raw (m, &array[i]);
}
-#endif
-#if 0
-static void
-mirror_misc_ptr (struct igc_mirror *m, struct Lisp_Misc_Ptr *p)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
+#define IGC_MIRROR_NOBJS(m, a, n) mirror_nobj (m, a, n)
-#if 0
static void
-mirror_user_ptr (struct igc_mirror *m, struct Lisp_User_Ptr *p)
+mirror_fwd (struct igc_mirror *m, lispfwd fwd)
{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
+ switch (XFWDTYPE (fwd))
+ {
+ case Lisp_Fwd_Int:
+ case Lisp_Fwd_Bool:
+ case Lisp_Fwd_Kboard_Obj:
+ break;
-#if 0
-static void
-mirror_thread (struct igc_mirror *m, struct thread_state *s)
-{
- IGC_MIRROR_VECTORLIKE (m, s);
- IGC_MIRROR_RAW (m, &s->m_current_buffer);
- IGC_MIRROR_RAW (m, &s->next_thread);
- IGC_MIRROR_RAW (m, &s->m_handlerlist);
-}
-#endif
+ case Lisp_Fwd_Obj:
+ {
+ struct Lisp_Objfwd *o = (void *) fwd.fwdptr;
+ IGC_MIRROR_OBJ (m, o->objvar);
+ }
+ break;
-#if 0
-static void
-mirror_terminal (struct igc_mirror *m, struct terminal *t)
-{
- IGC_NOT_IMPLEMENTED ();
+ case Lisp_Fwd_Buffer_Obj:
+ {
+ struct Lisp_Buffer_Objfwd *b = (void *) fwd.fwdptr;
+ IGC_MIRROR_OBJ (m, &b->predicate);
+ }
+ break;
+ }
}
-#endif
-#if 0
static void
-mirror_marker (struct igc_mirror *m, struct Lisp_Marker *ma)
+mirror_vectorlike_ (struct igc_mirror *m, struct Lisp_Vector *v)
{
- IGC_MIRROR_RAW (m, &ma->buffer);
+ ptrdiff_t size = vector_size (v);
+ IGC_MIRROR_NOBJS (m, v->contents, size);
}
-#endif
-#if 0
-static void
-mirror_finalizer (struct igc_mirror *m, struct Lisp_Finalizer *f)
-{
- IGC_NOT_IMPLEMENTED ();
-}
-#endif
+#define IGC_MIRROR_VECTORLIKE(m, v) \
+ mirror_vectorlike_ ((m), (struct Lisp_Vector *) (v))
-#if 0
-static void
-mirror_comp_unit (struct igc_mirror *m, struct Lisp_Native_Comp_Unit *u)
-{
- IGC_MIRROR_VECTORLIKE (m, u);
-}
-#endif
#ifdef HAVE_XWIDGETS
static void
@@ -4593,221 +3338,6 @@ mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r)
}
#endif
-#if 0
-static void
-mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client)
-{
- switch (pseudo_vector_type (client->header))
- {
-#ifndef IN_MY_FORK
- case PVEC_OBARRAY:
- mirror_obarray (m, client);
- break;
-#endif
-
- case PVEC_BUFFER:
- mirror_buffer (m, client);
- break;
-
- case PVEC_FRAME:
- mirror_frame (m, client);
- break;
-
- case PVEC_WINDOW:
- mirror_window (m, client);
- break;
-
- case PVEC_HASH_TABLE:
- mirror_hash_table (m, client);
- break;
-
- case PVEC_CHAR_TABLE:
- case PVEC_SUB_CHAR_TABLE:
- mirror_char_table (m, client);
- break;
-
- case PVEC_BOOL_VECTOR:
- break;
-
- case PVEC_OVERLAY:
- mirror_overlay (m, client);
- break;
-
- case PVEC_SUBR:
- mirror_subr (m, client);
- break;
-
- case PVEC_FREE:
- emacs_abort ();
-
- case PVEC_FINALIZER:
- mirror_finalizer (m, client);
- break;
-
- case PVEC_MISC_PTR:
- mirror_misc_ptr (m, client);
- break;
-
- case PVEC_USER_PTR:
- mirror_user_ptr (m, client);
- break;
-
-#ifdef HAVE_XWIDGETS
- case PVEC_XWIDGET:
- mirror_xwidget (c, client);
- break;
-
- case PVEC_XWIDGET_VIEW:
- mirror_widget_view (c, client);
- break;
-#endif
-
- case PVEC_THREAD:
- mirror_thread (m, client);
- break;
-
- case PVEC_MUTEX:
- mirror_mutex (m, client);
- break;
-
- case PVEC_TERMINAL:
- mirror_terminal (m, client);
- break;
-
- case PVEC_MARKER:
- mirror_marker (m, client);
- break;
-
- case PVEC_BIGNUM:
- break;
-
- case PVEC_NATIVE_COMP_UNIT:
- mirror_comp_unit (m, client);
- break;
-
- case PVEC_MODULE_GLOBAL_REFERENCE:
-#ifdef HAVE_MODULES
- mirror_global_ref (m, client);
-#endif
- break;
-
- case PVEC_FONT:
- mirror_font (m, client);
- break;
-
- case PVEC_NORMAL_VECTOR:
- case PVEC_SYMBOL_WITH_POS:
- case PVEC_PROCESS:
- case PVEC_WINDOW_CONFIGURATION:
- case PVEC_XWIDGET:
- case PVEC_XWIDGET_VIEW:
- case PVEC_MODULE_FUNCTION:
- case PVEC_CONDVAR:
- case PVEC_TS_COMPILED_QUERY:
- case PVEC_TS_NODE:
- case PVEC_TS_PARSER:
- case PVEC_SQLITE:
- case PVEC_CLOSURE:
- case PVEC_RECORD:
- case PVEC_OTHER:
-#ifdef IN_MY_FORK
- case PVEC_PACKAGE:
-#endif
- IGC_MIRROR_VECTORLIKE (m, client);
- break;
- }
-}
-#endif
-
-#if 0
-static void
-mirror (struct igc_mirror *m, void *org_base, void *copy_base)
-{
- void *client = base_to_client (copy_base);
- struct igc_header *h = copy_base;
- switch (h->obj_type)
- {
- case IGC_OBJ_BUILTIN_SYMBOL:
- case IGC_OBJ_BUILTIN_THREAD:
- case IGC_OBJ_BUILTIN_SUBR:
- break;
-
- case IGC_OBJ_PAD:
- case IGC_OBJ_FWD:
- case IGC_OBJ_INVALID:
- case IGC_OBJ_NUM_TYPES:
- emacs_abort ();
-
- case IGC_OBJ_OBJ_VEC:
- case IGC_OBJ_HASH_VEC:
- mirror_obj_vec (m, client);
- break;
-
- case IGC_OBJ_HANDLER:
- mirror_handler (m, client);
- break;
-
- case IGC_OBJ_PTR_VEC:
- mirror_ptr_vec (m, client);
- break;
-
- case IGC_OBJ_CONS:
- mirror_cons (m, client);
- break;
-
- case IGC_OBJ_STRING_DATA:
- case IGC_OBJ_FLOAT:
- case IGC_OBJ_BYTES:
- break;
-
- case IGC_OBJ_SYMBOL:
- mirror_symbol (m, client);
- break;
-
- case IGC_OBJ_INTERVAL:
- mirror_interval (m, client);
- break;
-
- case IGC_OBJ_STRING:
- mirror_string (m, client);
- break;
-
- case IGC_OBJ_VECTOR:
- case IGC_OBJ_VECTOR_WEAK:
- mirror_vector (m, client);
- break;
-
- case IGC_OBJ_ITREE_TREE:
- mirror_itree_tree (m, client);
- break;
-
- case IGC_OBJ_ITREE_NODE:
- mirror_itree_node (m, client);
- break;
-
- case IGC_OBJ_IMAGE:
- mirror_image (m, client);
- break;
-
- case IGC_OBJ_IMAGE_CACHE:
- mirror_image_cache (m, client);
- break;
-
- case IGC_OBJ_FACE:
- mirror_face (m, client);
- break;
-
- case IGC_OBJ_FACE_CACHE:
- mirror_face_cache (m, client);
- break;
-
- case IGC_OBJ_BLV:
- mirror_blv (m, client);
- break;
- }
-}
-#endif
-
static void
mirror_references (struct igc_mirror *m)
{
--
2.39.2
^ permalink raw reply related [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 9:07 ` MPS codegen (was: MPS: Update) Helmut Eller
@ 2024-06-13 12:33 ` Gerd Möllmann
2024-06-13 17:48 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-13 12:33 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
> The patches below use a code generator for most of the fix an mirror
> functions. I dropped tree-sitter for now; maybe it can be used for
> something later. The code generator is about 800 lines and the
> generated code 1600. However the generated code is longer than hand
> written code. WDYT?
Hm, to be honest, how do I say it? Please don't feel offended, but I
think I don't like it that much :-).
I think the thing I don't like is that I believe there should be only
one description of an object's layout. Be it C (struct), or be it
somethings else, from which C is generated.
Just my 2 cents, of course.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 12:33 ` MPS codegen Gerd Möllmann
@ 2024-06-13 17:48 ` Helmut Eller
2024-06-13 18:24 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-13 17:48 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, emacs-devel
On Thu, Jun 13 2024, Gerd Möllmann wrote:
>> The patches below use a code generator for most of the fix an mirror
>> functions. I dropped tree-sitter for now; maybe it can be used for
>> something later. The code generator is about 800 lines and the
>> generated code 1600. However the generated code is longer than hand
>> written code. WDYT?
>
> Hm, to be honest, how do I say it? Please don't feel offended, but I
> think I don't like it that much :-).
I'm also not fully convinced that code generation is an improvement.
> I think the thing I don't like is that I believe there should be only
> one description of an object's layout. Be it C (struct), or be it
> somethings else, from which C is generated.
Sure, but that's easier said than done.
BTW, the MPS documentation says that mps_reserve allocates a block. In
MPS, a block is not necessarily a single object. One possible
interpretation of this could be that mps_reserve can be used to allocate
a block that contains many objects. Perhaps we could use a single block
for the entire dump? E.g. implement a version of dump_mmap_contiguous
that uses mps_reserve. What's your interpretation?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 17:48 ` Helmut Eller
@ 2024-06-13 18:24 ` Gerd Möllmann
2024-06-13 18:31 ` Gerd Möllmann
` (2 more replies)
0 siblings, 3 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-13 18:24 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
>> I think the thing I don't like is that I believe there should be only
>> one description of an object's layout. Be it C (struct), or be it
>> somethings else, from which C is generated.
>
> Sure, but that's easier said than done.
Yeah :-). Too bad that GCC doesn't have something like Clang's Python
API. Somehow I don't really believe in tree-sitter for this specific
purpose. But what do I know...
> BTW, the MPS documentation says that mps_reserve allocates a block. In
> MPS, a block is not necessarily a single object. One possible
> interpretation of this could be that mps_reserve can be used to allocate
> a block that contains many objects. Perhaps we could use a single block
> for the entire dump? E.g. implement a version of dump_mmap_contiguous
> that uses mps_reserve. What's your interpretation?
The same. I think I've read somewhere that anything goes in such a block
as long as the object format can cope with it.
OTOH, on my machine, the whole copying of the dump to MPS, mirroring and
redirecting roots takes ca. 38ms ATM. Where the copying and mirroring
are the two main contributors and take about the same time. Maybe
there's not much to win.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 18:24 ` Gerd Möllmann
@ 2024-06-13 18:31 ` Gerd Möllmann
2024-06-13 18:38 ` Helmut Eller
2024-06-13 23:09 ` Andrea Corallo
2 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-13 18:31 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Helmut Eller <eller.helmut@gmail.com> writes:
>
>>> I think the thing I don't like is that I believe there should be only
>>> one description of an object's layout. Be it C (struct), or be it
>>> somethings else, from which C is generated.
>>
>> Sure, but that's easier said than done.
>
> Yeah :-). Too bad that GCC doesn't have something like Clang's Python
> API. Somehow I don't really believe in tree-sitter for this specific
> purpose. But what do I know...
>
>> BTW, the MPS documentation says that mps_reserve allocates a block. In
>> MPS, a block is not necessarily a single object. One possible
>> interpretation of this could be that mps_reserve can be used to allocate
>> a block that contains many objects. Perhaps we could use a single block
>> for the entire dump? E.g. implement a version of dump_mmap_contiguous
>> that uses mps_reserve. What's your interpretation?
>
> The same. I think I've read somewhere that anything goes in such a block
> as long as the object format can cope with it.
>
> OTOH, on my machine, the whole copying of the dump to MPS, mirroring and
> redirecting roots takes ca. 38ms ATM. Where the copying and mirroring
> are the two main contributors and take about the same time. Maybe
> there's not much to win.
Here's what it prints, times can vary a bit
/Users/gerd/emacs/github/igc % IGC_MIRROR_STATS=1 src/emacs -Q
--------------------------------------------------
Type N Bytes
--------------------------------------------------
IGC_OBJ_INVALID 0 0
IGC_OBJ_PAD 0 0
IGC_OBJ_FWD 0 0
IGC_OBJ_CONS 285532 6852768
IGC_OBJ_SYMBOL 16268 911008
IGC_OBJ_INTERVAL 31 1984
IGC_OBJ_STRING 62964 2518560
IGC_OBJ_STRING_DATA 62964 2237944
IGC_OBJ_VECTOR 41660 6023960
IGC_OBJ_VECTOR_WEAK 5 208
IGC_OBJ_ITREE_TREE 0 0
IGC_OBJ_ITREE_NODE 4 352
IGC_OBJ_IMAGE 0 0
IGC_OBJ_IMAGE_CACHE 0 0
IGC_OBJ_FACE 0 0
IGC_OBJ_FACE_CACHE 0 0
IGC_OBJ_FLOAT 169 4056
IGC_OBJ_BLV 164 7872
IGC_OBJ_PTR_VEC 0 0
IGC_OBJ_OBJ_VEC 0 0
IGC_OBJ_HASH_VEC 528 376528
IGC_OBJ_HANDLER 0 0
IGC_OBJ_BYTES 0 0
IGC_OBJ_BUILTIN_SYMBOL 0 0
IGC_OBJ_BUILTIN_THREAD 0 0
IGC_OBJ_BUILTIN_SUBR 0 0
--------------------------------------------------
Type N Bytes
--------------------------------------------------
PVEC_NORMAL_VECTOR 29569 1588104
PVEC_FREE 0 0
PVEC_BIGNUM 0 0
PVEC_MARKER 18 864
PVEC_OVERLAY 4 160
PVEC_FINALIZER 0 0
PVEC_SYMBOL_WITH_POS 0 0
PVEC_MISC_PTR 0 0
PVEC_USER_PTR 0 0
PVEC_PROCESS 0 0
PVEC_FRAME 1 592
PVEC_WINDOW 2 1088
PVEC_BOOL_VECTOR 340 13600
PVEC_BUFFER 6 6000
PVEC_HASH_TABLE 322 28336
PVEC_TERMINAL 0 0
PVEC_WINDOW_CONFIGURATION 0 0
PVEC_SUBR 0 0
PVEC_PACKAGE 24 1728
PVEC_OTHER 0 0
PVEC_XWIDGET 0 0
PVEC_XWIDGET_VIEW 0 0
PVEC_THREAD 0 0
PVEC_MUTEX 0 0
PVEC_CONDVAR 0 0
PVEC_MODULE_FUNCTION 0 0
PVEC_MODULE_GLOBAL_REFERENCE 0 0
PVEC_NATIVE_COMP_UNIT 0 0
PVEC_TS_PARSER 0 0
PVEC_TS_NODE 0 0
PVEC_TS_COMPILED_QUERY 0 0
PVEC_SQLITE 0 0
PVEC_CLOSURE 6585 372048
PVEC_CHAR_TABLE 80 45864
PVEC_SUB_CHAR_TABLE 4305 3941400
PVEC_RECORD 402 23936
PVEC_FONT 2 240
--------------------------------------------------
Total 470289 18935240
--------------------------------------------------
Copy objects to MPS 0.0197s
Mirror references 0.0152s
Redirect roots 0.0001s
Total time 0.0351s
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 18:24 ` Gerd Möllmann
2024-06-13 18:31 ` Gerd Möllmann
@ 2024-06-13 18:38 ` Helmut Eller
2024-06-13 18:54 ` Gerd Möllmann
2024-06-13 23:09 ` Andrea Corallo
2 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-13 18:38 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, emacs-devel
> OTOH, on my machine, the whole copying of the dump to MPS, mirroring and
> redirecting roots takes ca. 38ms ATM. Where the copying and mirroring
> are the two main contributors and take about the same time. Maybe
> there's not much to win.
The win would be that no code for copying and mirroring would be needed.
One downside would be that the hot and cold section end up in the same
pool.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 18:38 ` Helmut Eller
@ 2024-06-13 18:54 ` Gerd Möllmann
2024-06-13 19:15 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-13 18:54 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
>> OTOH, on my machine, the whole copying of the dump to MPS, mirroring and
>> redirecting roots takes ca. 38ms ATM. Where the copying and mirroring
>> are the two main contributors and take about the same time. Maybe
>> there's not much to win.
>
> The win would be that no code for copying and mirroring would be needed.
> One downside would be that the hot and cold section end up in the same
> pool.
Then I didn't understand what you meant. How would you avoid the
copying? I don't remember seeing something in the MPS docs by which one
could let it manage a area of memory the user can allocate or specify.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 18:54 ` Gerd Möllmann
@ 2024-06-13 19:15 ` Helmut Eller
2024-06-13 19:37 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-13 19:15 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, emacs-devel
>> The win would be that no code for copying and mirroring would be needed.
>> One downside would be that the hot and cold section end up in the same
>> pool.
>
> Then I didn't understand what you meant. How would you avoid the
> copying? I don't remember seeing something in the MPS docs by which one
> could let it manage a area of memory the user can allocate or specify.
The idea is simply to do something like dump_mmap_contiguous_heap.
Instead of malloc'ing the contiguous chunk of memory use mps_reserve.
After the pdumper has done the usual relocations call mps_commit.
(It might not work out quite like this because the pdumper wants to
allocate something too early, ie. before the mps_commit. But that's the
basic idea.)
The crucial bit that I'm unsure about is if mps_reserve can be used to
allocate many objects in this way.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 19:15 ` Helmut Eller
@ 2024-06-13 19:37 ` Gerd Möllmann
2024-06-14 6:37 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-13 19:37 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
>>> The win would be that no code for copying and mirroring would be needed.
>>> One downside would be that the hot and cold section end up in the same
>>> pool.
>>
>> Then I didn't understand what you meant. How would you avoid the
>> copying? I don't remember seeing something in the MPS docs by which one
>> could let it manage a area of memory the user can allocate or specify.
>
> The idea is simply to do something like dump_mmap_contiguous_heap.
> Instead of malloc'ing the contiguous chunk of memory use mps_reserve.
> After the pdumper has done the usual relocations call mps_commit.
Ah, that's an intersting idea!
> (It might not work out quite like this because the pdumper wants to
> allocate something too early, ie. before the mps_commit. But that's the
> basic idea.)
Maybe one could reserve + commit a suitable block upfront, maybe as one
big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
block.
One problem would be to make the whole thing digestable for the object
format. And maybe one would loose the ability to use the leaf pool for
some objects in the dump. But maybe that's not a big deal. MPS then
calls the scan method which does nothing, but that should be the whole
overhead, I guess.
If one could get rid of the mirroring code, that would be a big
advantage :-)!
> The crucial bit that I'm unsure about is if mps_reserve can be used to
> allocate many objects in this way.
I think it can. But the proof is in the pudding, of course :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 18:24 ` Gerd Möllmann
2024-06-13 18:31 ` Gerd Möllmann
2024-06-13 18:38 ` Helmut Eller
@ 2024-06-13 23:09 ` Andrea Corallo
2024-06-14 6:08 ` Gerd Möllmann
2 siblings, 1 reply; 62+ messages in thread
From: Andrea Corallo @ 2024-06-13 23:09 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Helmut Eller, Eli Zaretskii, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Helmut Eller <eller.helmut@gmail.com> writes:
>
>>> I think the thing I don't like is that I believe there should be only
>>> one description of an object's layout. Be it C (struct), or be it
>>> somethings else, from which C is generated.
>>
>> Sure, but that's easier said than done.
>
> Yeah :-). Too bad that GCC doesn't have something like Clang's Python
> API. Somehow I don't really believe in tree-sitter for this specific
> purpose. But what do I know...
It has (I think). I posted the link already somewhere in one of the MPS
related threads:
<https://gcc-python-plugin.readthedocs.io/en/latest/>
At the time I tried to hack something to generate the code you wanted
(well my interpretation as I never got the minimal example I asked for)
but when Eli suggested treesitter I gave-up as I thought was a good (and
better) suggestion. Why do you think treesitter is not up to the task?
Andrea
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 23:09 ` Andrea Corallo
@ 2024-06-14 6:08 ` Gerd Möllmann
2024-06-14 7:45 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 6:08 UTC (permalink / raw)
To: Andrea Corallo; +Cc: Helmut Eller, Eli Zaretskii, emacs-devel
Andrea Corallo <acorallo@gnu.org> writes:
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>>>> I think the thing I don't like is that I believe there should be only
>>>> one description of an object's layout. Be it C (struct), or be it
>>>> somethings else, from which C is generated.
>>>
>>> Sure, but that's easier said than done.
>>
>> Yeah :-). Too bad that GCC doesn't have something like Clang's Python
>> API. Somehow I don't really believe in tree-sitter for this specific
>> purpose. But what do I know...
>
> It has (I think). I posted the link already somewhere in one of the MPS
> related threads:
>
> <https://gcc-python-plugin.readthedocs.io/en/latest/>
Thanks for the reminder. I had forgotten again. How do the GCC docs fare
wrt to GCC internals like the trees? Clang is pretty bad in that regard,
IMHO.
>
> At the time I tried to hack something to generate the code you wanted
> (well my interpretation as I never got the minimal example I asked for)
> but when Eli suggested treesitter I gave-up as I thought was a good (and
> better) suggestion.
The Lisp code Helmut posted could serve as an example, I think. The task
would be to replace the manual object layout descriptions with ones
generated from C code. Or something like that.
BTW, if Helmut's idea wrt to loading the dump into MPS works, I'd
personally consider generation of scanning code less of an urgent
problem, although it still would be nice of course, and it might also be
nice to use for things like the dumper and the old GC. But that's
another project.
BTW, @Helmut: do you plan to work on this idea? I'm asking because I'm
in sort of a buf-fixing-only mode right now, i.e. I'm trying to make it
work well enough that I can use it and get an impression how it does
while doing something completely different from MPS. (Alas, I had to fix
one or there things to make that possible.) So, I'll probably not
tackle your dumper idea in the near future...
> Why do you think treesitter is not up to the task?
Well, I get that impression because it "only" operates on a syntactic
level. But as I said, what do I know... :-)
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-13 19:37 ` Gerd Möllmann
@ 2024-06-14 6:37 ` Eli Zaretskii
2024-06-14 7:30 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 6:37 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
> Date: Thu, 13 Jun 2024 21:37:41 +0200
>
> Maybe one could reserve + commit a suitable block upfront, maybe as one
> big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
> block.
Wouldn't that slow down startup? pdumper uses memory-mapped files to
make that as fast as possible, and for a good reason: at the time
pdumper was introduced people objected to have startup slow down even
by a few hundreds of milliseconds.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 6:37 ` Eli Zaretskii
@ 2024-06-14 7:30 ` Gerd Möllmann
2024-06-14 7:56 ` Gerd Möllmann
2024-06-14 10:46 ` Eli Zaretskii
0 siblings, 2 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 7:30 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
>> Date: Thu, 13 Jun 2024 21:37:41 +0200
>>
>> Maybe one could reserve + commit a suitable block upfront, maybe as one
>> big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
>> block.
>
> Wouldn't that slow down startup? pdumper uses memory-mapped files to
> make that as fast as possible, and for a good reason: at the time
> pdumper was introduced people objected to have startup slow down even
> by a few hundreds of milliseconds.
I don't know. Did pdumper do many reads that were replaced with one
mmap? This one could do one large read instead of one mmap.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 6:08 ` Gerd Möllmann
@ 2024-06-14 7:45 ` Helmut Eller
2024-06-14 7:59 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-14 7:45 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Andrea Corallo, Eli Zaretskii, emacs-devel
On Fri, Jun 14 2024, Gerd Möllmann wrote:
>> At the time I tried to hack something to generate the code you wanted
>> (well my interpretation as I never got the minimal example I asked for)
>> but when Eli suggested treesitter I gave-up as I thought was a good (and
>> better) suggestion.
>
> The Lisp code Helmut posted could serve as an example, I think. The task
> would be to replace the manual object layout descriptions with ones
> generated from C code. Or something like that.
A nice approach would be to use C23 attribute syntax to add annotations
in the existing C structs. Then extract the layout descriptions from
those annotations. But how the actual annotations should look like is
not clear. E.g. how to express the "switch fields" that I used in the
layout description. There are lots of other details like this that
don't have obvious solutions.
> BTW, @Helmut: do you plan to work on this idea? I'm asking because I'm
> in sort of a buf-fixing-only mode right now, i.e. I'm trying to make it
> work well enough that I can use it and get an impression how it does
> while doing something completely different from MPS. (Alas, I had to fix
> one or there things to make that possible.) So, I'll probably not
> tackle your dumper idea in the near future...
I planned to give it a try, but not until somebody™ updates the branch
on savannah. Otherwise patches to pdumper.c don't apply cleanly.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 7:30 ` Gerd Möllmann
@ 2024-06-14 7:56 ` Gerd Möllmann
2024-06-14 10:52 ` Eli Zaretskii
2024-06-14 10:46 ` Eli Zaretskii
1 sibling, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 7:56 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>>> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
>>> Date: Thu, 13 Jun 2024 21:37:41 +0200
>>>
>>> Maybe one could reserve + commit a suitable block upfront, maybe as one
>>> big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
>>> block.
>>
>> Wouldn't that slow down startup? pdumper uses memory-mapped files to
>> make that as fast as possible, and for a good reason: at the time
>> pdumper was introduced people objected to have startup slow down even
>> by a few hundreds of milliseconds.
>
> I don't know. Did pdumper do many reads that were replaced with one
> mmap? This one could do one large read instead of one mmap.
Found this benchmarking code:
https://github.com/david-slatinek/c-read-vs.-mmap
It comes to the conclusion that, for 32MB files, mmap is 17% faster than
a sequence of reads of 16Kb each (2000 calls). Hm.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 7:45 ` Helmut Eller
@ 2024-06-14 7:59 ` Gerd Möllmann
2024-06-14 8:28 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 7:59 UTC (permalink / raw)
To: Helmut Eller; +Cc: Andrea Corallo, Eli Zaretskii, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
> I planned to give it a try, but not until somebody™ updates the branch
> on savannah. Otherwise patches to pdumper.c don't apply cleanly.
Ok, ok, I'll give it a try now that you did the obarray and pure space
thing. No pressure :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 7:59 ` Gerd Möllmann
@ 2024-06-14 8:28 ` Gerd Möllmann
2024-06-14 8:51 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 8:28 UTC (permalink / raw)
To: Helmut Eller; +Cc: Andrea Corallo, Eli Zaretskii, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> I planned to give it a try, but not until somebody™ updates the branch
>> on savannah. Otherwise patches to pdumper.c don't apply cleanly.
>
> Ok, ok, I'll give it a try now that you did the obarray and pure space
> thing. No pressure :-).
By our command. Done :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 8:28 ` Gerd Möllmann
@ 2024-06-14 8:51 ` Helmut Eller
2024-06-14 11:32 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-14 8:51 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Andrea Corallo, Eli Zaretskii, emacs-devel
On Fri, Jun 14 2024, Gerd Möllmann wrote:
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>>> I planned to give it a try, but not until somebody™ updates the branch
>>> on savannah. Otherwise patches to pdumper.c don't apply cleanly.
>>
>> Ok, ok, I'll give it a try now that you did the obarray and pure space
>> thing. No pressure :-).
>
> By our command. Done :-).
Thanks!
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 7:30 ` Gerd Möllmann
2024-06-14 7:56 ` Gerd Möllmann
@ 2024-06-14 10:46 ` Eli Zaretskii
1 sibling, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 10:46 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 09:30:31 +0200
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> >> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> >> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
> >> Date: Thu, 13 Jun 2024 21:37:41 +0200
> >>
> >> Maybe one could reserve + commit a suitable block upfront, maybe as one
> >> big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
> >> block.
> >
> > Wouldn't that slow down startup? pdumper uses memory-mapped files to
> > make that as fast as possible, and for a good reason: at the time
> > pdumper was introduced people objected to have startup slow down even
> > by a few hundreds of milliseconds.
>
> I don't know. Did pdumper do many reads that were replaced with one
> mmap? This one could do one large read instead of one mmap.
pdumper never did any reads, it was implemented from the get-go to use
mmap and equivalent APIs.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 7:56 ` Gerd Möllmann
@ 2024-06-14 10:52 ` Eli Zaretskii
0 siblings, 0 replies; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 10:52 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 09:56:07 +0200
>
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
> > Eli Zaretskii <eliz@gnu.org> writes:
> >
> >>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> >>> Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
> >>> Date: Thu, 13 Jun 2024 21:37:41 +0200
> >>>
> >>> Maybe one could reserve + commit a suitable block upfront, maybe as one
> >>> big IGC_OBJ_PAD, and use read(2) or so to read the .pdmp into that
> >>> block.
> >>
> >> Wouldn't that slow down startup? pdumper uses memory-mapped files to
> >> make that as fast as possible, and for a good reason: at the time
> >> pdumper was introduced people objected to have startup slow down even
> >> by a few hundreds of milliseconds.
> >
> > I don't know. Did pdumper do many reads that were replaced with one
> > mmap? This one could do one large read instead of one mmap.
>
> Found this benchmarking code:
>
> https://github.com/david-slatinek/c-read-vs.-mmap
>
> It comes to the conclusion that, for 32MB files, mmap is 17% faster than
> a sequence of reads of 16Kb each (2000 calls). Hm.
I think we need absolute timings, not relative ones. The pdumper code
times itself, see pdumper-stats. For example, the production session
where I'm typing this took 17.4 msec to run all of pdumper_load. We
need to be sure any new code, if it is implemented, does not add any
significant time to the baseline.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 8:51 ` Helmut Eller
@ 2024-06-14 11:32 ` Eli Zaretskii
2024-06-14 12:43 ` Gerd Möllmann
2024-06-14 16:30 ` Helmut Eller
0 siblings, 2 replies; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 11:32 UTC (permalink / raw)
To: Helmut Eller; +Cc: gerd.moellmann, acorallo, emacs-devel
> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: Andrea Corallo <acorallo@gnu.org>, Eli Zaretskii <eliz@gnu.org>,
> emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 10:51:38 +0200
>
> On Fri, Jun 14 2024, Gerd Möllmann wrote:
>
> > Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> >
> >> Helmut Eller <eller.helmut@gmail.com> writes:
> >>
> >>> I planned to give it a try, but not until somebody™ updates the branch
> >>> on savannah. Otherwise patches to pdumper.c don't apply cleanly.
> >>
> >> Ok, ok, I'll give it a try now that you did the obarray and pure space
> >> thing. No pressure :-).
> >
> > By our command. Done :-).
>
> Thanks!
Too soon to be happy: the MS-Windows 32-bit build is now broken: it
segfaults while producing loaddefs.el:
Starting program: d:\gnu\git\emacs\feature\src\emacs.exe -batch --no-site-file --no-site-lisp -l ./emacs-lisp/loaddefs-gen.elc -f loaddefs-generate--emacs-batch . ./calc ./calendar ./cedet ./cedet/ede ./cedet/semantic ./cedet/semantic/analyze ./cedet/semantic/bovine ./cedet/semantic/decorate ./cedet/semantic/symref ./cedet/semantic/wisent ./cedet/srecode ./emacs-lisp ./emulation ./erc ./eshell ./gnus ./image ./international ./language ./leim ./leim/ja-dic ./leim/quail ./mail ./mh-e ./net ./nxml ./org ./play ./progmodes ./textmodes ./url ./use-package ./vc
[New Thread 30924.0x8288]
[New Thread 30924.0x8448]
[New Thread 30924.0x87bc]
warning: Enabling Low Fragmentation Heap failed: error 87
Thread 1 received signal SIGSEGV, Segmentation fault.
do_symval_forwarding (valcontents=...) at data.c:1334
1334 switch (XFWDTYPE (valcontents))
(gdb) bt
#0 do_symval_forwarding (valcontents=...) at data.c:1334
#1 0x008a576d in specbind (symbol=<optimized out>, symbol@entry=XIL(0x53b8),
value=value@entry=XIL(0x18)) at eval.c:3572
#2 0x0073fb6e in message_dolog (m=<optimized out>, nbytes=<optimized out>,
nlflag=true, multibyte=false) at lisp.h:1191
#3 0x0074a3b0 in message_dolog (m=<optimized out>,
m@entry=0xde85d1 <b_fwd+1597> "", nbytes=nbytes@entry=0,
nlflag=nlflag@entry=true, multibyte=multibyte@entry=false) at xdisp.c:12216
#4 0x00a4c0a5 in main (argc=<optimized out>, argv=<optimized out>)
at emacs.c:2229
(gdb) fr 2
#2 0x008a576d in specbind (symbol=<optimized out>, symbol@entry=XIL(0x53b8),
value=value@entry=XIL(0x18)) at eval.c:3572
3572 Lisp_Object ovalue = find_symbol_value (symbol);
(gdb) l
3567 specpdl_ptr->let.where.kbd = NULL;
3568 break;
3569 case SYMBOL_LOCALIZED:
3570 case SYMBOL_FORWARDED:
3571 {
3572 Lisp_Object ovalue = find_symbol_value (symbol);
3573 specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
3574 specpdl_ptr->let.symbol = symbol;
3575 specpdl_ptr->let.old_value = ovalue;
3576 specpdl_ptr->let.where.buf = Fcurrent_buffer ();
(gdb) p symbol
$1 = <optimized out>
I get basically the same segfault and backtrace if I delete
loaddefs-gen.elc and run "make"; repeating the same command under GDB
produces this:
Starting program: d:\gnu\git\emacs\feature\src\emacs.exe -batch --no-site-file --no-site-lisp --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" --eval "(setq org--inhibit-version-check t)" -f batch-byte-compile emacs-lisp/loaddefs-gen.el
[New Thread 30136.0x8330]
[New Thread 30136.0x81c8]
[New Thread 30136.0x843c]
warning: Enabling Low Fragmentation Heap failed: error 87
Thread 1 received signal SIGSEGV, Segmentation fault.
do_symval_forwarding (valcontents=...) at data.c:1334
1334 switch (XFWDTYPE (valcontents))
(gdb) bt
#0 do_symval_forwarding (valcontents=...) at data.c:1334
#1 0x008a576d in specbind (symbol=<optimized out>, symbol@entry=XIL(0x53b8),
value=value@entry=XIL(0x18)) at eval.c:3572
#2 0x0073fb6e in message_dolog (m=<optimized out>, nbytes=<optimized out>,
nlflag=true, multibyte=false) at lisp.h:1191
#3 0x0074a3b0 in message_dolog (m=<optimized out>,
m@entry=0xde85d1 <b_fwd+1597> "", nbytes=nbytes@entry=0,
nlflag=nlflag@entry=true, multibyte=multibyte@entry=false) at xdisp.c:12216
#4 0x00a4c0a5 in main (argc=<optimized out>, argv=<optimized out>)
at emacs.c:2229
(gdb) fr 2
#2 0x008a576d in specbind (symbol=<optimized out>, symbol@entry=XIL(0x53b8),
value=value@entry=XIL(0x18)) at eval.c:3572
3572 Lisp_Object ovalue = find_symbol_value (symbol);
(gdb) p symbol
$1 = <optimized out>
(gdb) l
3567 specpdl_ptr->let.where.kbd = NULL;
3568 break;
3569 case SYMBOL_LOCALIZED:
3570 case SYMBOL_FORWARDED:
3571 {
3572 Lisp_Object ovalue = find_symbol_value (symbol);
3573 specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
3574 specpdl_ptr->let.symbol = symbol;
3575 specpdl_ptr->let.old_value = ovalue;
3576 specpdl_ptr->let.where.buf = Fcurrent_buffer ();
(gdb) p sym
$2 = (struct Lisp_Symbol *) 0xee7f98 <lispsym+21432>
(gdb) p *$
$3 = {
u = {
s = {
gcmarkbit = 0,
redirect = SYMBOL_FORWARDED,
trapped_write = SYMBOL_UNTRAPPED_WRITE,
interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY,
declared_special = 1,
pinned = 0,
name = XIL(0xc0dbaa4),
val = {
value = XIL(0x1a986958),
alias = 0x1a986958,
blv = 0x1a986958,
fwd = {
fwdptr = 0x1a986958
}
},
function = XIL(0),
plist = XIL(0xc0dbabb),
next = 0x0
},
gcaligned = -58 'Æ'
}
}
(gdb) p $->name
There is no member named name.
(gdb) p $->u.s.name
$4 = XIL(0xc0dbaa4)
(gdb) xtype
Lisp_String
(gdb) xstring
$5 = (struct Lisp_String *) 0xc0dbaa0
"inhibit-modification-hooks"
(gdb) p $->u.s.val
There is no member named val.
(gdb) p $2->u.s.val
$6 = {
value = XIL(0x1a986958),
alias = 0x1a986958,
blv = 0x1a986958,
fwd = {
fwdptr = 0x1a986958
}
}
(gdb) p $2->u.s.val.value
$7 = XIL(0x1a986958)
(gdb) xtype
Lisp_Symbol
(gdb) xsymbol
$8 = (struct Lisp_Symbol *) 0x1b869538
Cannot access memory at address 0x1b86953c
(gdb)
Any ideas or suggestions? Does the current branch build on GNU/Linus
as a 32-bit executable?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 11:32 ` Eli Zaretskii
@ 2024-06-14 12:43 ` Gerd Möllmann
2024-06-14 13:04 ` Eli Zaretskii
2024-06-14 16:30 ` Helmut Eller
1 sibling, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 12:43 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Helmut Eller, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
> $2 = (struct Lisp_Symbol *) 0xee7f98 <lispsym+21432>
> (gdb) p *$
> $3 = {
> u = {
> s = {
> gcmarkbit = 0,
> redirect = SYMBOL_FORWARDED,
> trapped_write = SYMBOL_UNTRAPPED_WRITE,
> interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY,
...
> (gdb) p $2->u.s.val
> $6 = {
> value = XIL(0x1a986958),
> alias = 0x1a986958,
> blv = 0x1a986958,
> fwd = {
> fwdptr = 0x1a986958
> }
> }
> (gdb) p $2->u.s.val.value
For SYMBO:_FORWARDED, I think sym->u.val.fwd should be used. So I think
maybe it is somwhere in that direction. Perhaps function mirror_fwd?
> $7 = XIL(0x1a986958)
> (gdb) xtype
> Lisp_Symbol
> (gdb) xsymbol
> $8 = (struct Lisp_Symbol *) 0x1b869538
> Cannot access memory at address 0x1b86953c
> (gdb)
>
> Any ideas or suggestions? Does the current branch build on GNU/Linus
> as a 32-bit executable?
No idea.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 12:43 ` Gerd Möllmann
@ 2024-06-14 13:04 ` Eli Zaretskii
2024-06-14 13:17 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 13:04 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Helmut Eller <eller.helmut@gmail.com>, acorallo@gnu.org,
> emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 14:43:05 +0200
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> > $2 = (struct Lisp_Symbol *) 0xee7f98 <lispsym+21432>
> > (gdb) p *$
> > $3 = {
> > u = {
> > s = {
> > gcmarkbit = 0,
> > redirect = SYMBOL_FORWARDED,
> > trapped_write = SYMBOL_UNTRAPPED_WRITE,
> > interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY,
>
> ...
>
> > (gdb) p $2->u.s.val
> > $6 = {
> > value = XIL(0x1a986958),
> > alias = 0x1a986958,
> > blv = 0x1a986958,
> > fwd = {
> > fwdptr = 0x1a986958
> > }
> > }
> > (gdb) p $2->u.s.val.value
>
> For SYMBO:_FORWARDED, I think sym->u.val.fwd should be used. So I think
> maybe it is somwhere in that direction. Perhaps function mirror_fwd?
Sorry, I don't understand: all those values are identical, so how does
it matter which one we use? Or what am I missing?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 13:04 ` Eli Zaretskii
@ 2024-06-14 13:17 ` Gerd Möllmann
2024-06-14 13:46 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 13:17 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> For SYMBO:_FORWARDED, I think sym->u.val.fwd should be used. So I think
>> maybe it is somwhere in that direction. Perhaps function mirror_fwd?
>
> Sorry, I don't understand: all those values are identical, so how does
> it matter which one we use? Or what am I missing?
What I was trying to convey is kust that in this case mirror_fwd is used.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 13:17 ` Gerd Möllmann
@ 2024-06-14 13:46 ` Eli Zaretskii
2024-06-14 14:05 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 13:46 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 15:17:03 +0200
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> >> For SYMBO:_FORWARDED, I think sym->u.val.fwd should be used. So I think
> >> maybe it is somwhere in that direction. Perhaps function mirror_fwd?
> >
> > Sorry, I don't understand: all those values are identical, so how does
> > it matter which one we use? Or what am I missing?
>
> What I was trying to convey is kust that in this case mirror_fwd is used.
Is or should be?
I see mirror_fwd used only in igc.c, and it's a static function there.
I guess what I'm saying is that I don't understand what you suggest to
do or check to try to fix these segfaults.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 13:46 ` Eli Zaretskii
@ 2024-06-14 14:05 ` Gerd Möllmann
2024-06-14 14:33 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 14:05 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: eller.helmut@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
>> Date: Fri, 14 Jun 2024 15:17:03 +0200
>>
>> Eli Zaretskii <eliz@gnu.org> writes:
>>
>> >> For SYMBO:_FORWARDED, I think sym->u.val.fwd should be used. So I think
>> >> maybe it is somwhere in that direction. Perhaps function mirror_fwd?
>> >
>> > Sorry, I don't understand: all those values are identical, so how does
>> > it matter which one we use? Or what am I missing?
>>
>> What I was trying to convey is kust that in this case mirror_fwd is used.
>
> Is or should be?
Is.
> I see mirror_fwd used only in igc.c, and it's a static function there.
>
> I guess what I'm saying is that I don't understand what you suggest to
> do or check to try to fix these segfaults.
One big difference to before is that the object graph in the loaded dump
is copied top MPS (see igc_on_pdump_loaded).
This proceeds in steps.
1. iterate over objects in the dump and copy them. Record for each
object in dump what its copy is (igc_mirror::dump_to_mps).
2. iterate over objects in the copy, and "mirror" references, i.e.
replace references to the old graph with references in the copy.
Here, mirror_fwd comes into play, as subroutine of mirror_symbol.
3. Fix roots in a similar way.
4. Discard the dump.
I'd probably put a breakpoitn in mirror_fwd and look around if something
there is not right for IA32, or Windows, don't know.
It's just a guess, though.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 14:05 ` Gerd Möllmann
@ 2024-06-14 14:33 ` Eli Zaretskii
2024-06-14 14:46 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 14:33 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 16:05:03 +0200
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> >> What I was trying to convey is kust that in this case mirror_fwd is used.
> >
> > Is or should be?
>
> Is.
>
> > I see mirror_fwd used only in igc.c, and it's a static function there.
> >
> > I guess what I'm saying is that I don't understand what you suggest to
> > do or check to try to fix these segfaults.
>
> One big difference to before is that the object graph in the loaded dump
> is copied top MPS (see igc_on_pdump_loaded).
>
> This proceeds in steps.
>
> 1. iterate over objects in the dump and copy them. Record for each
> object in dump what its copy is (igc_mirror::dump_to_mps).
>
> 2. iterate over objects in the copy, and "mirror" references, i.e.
> replace references to the old graph with references in the copy.
> Here, mirror_fwd comes into play, as subroutine of mirror_symbol.
>
> 3. Fix roots in a similar way.
>
> 4. Discard the dump.
>
> I'd probably put a breakpoitn in mirror_fwd and look around if something
> there is not right for IA32, or Windows, don't know.
Thanks. But this kind of journey down the rabbit hole (mirror_fwd
leads to IGC_MIRROR_OBJ, which leads to mirror_lisp_obj, which leads
to look up_copy and a bunch of other functions whose functionality is
not documented anywhere) will have to wait for someone else. Sorry, I
have too much on my plate at this time: need to start the Emacs 30
release cycle.
I can only say that I tried to bisect your changes installed today,
and failed: almost all of the commits between 219f7d5 (the last one
which builds and works) and HEAD don't even compile due to compilation
errors (undeclared variables, missing functions, etc.), and those
which do compile crash when Emacs attempts to byte-compile some Lisp.
My guess is that something very basic in dumping and/or loading from
the pdumper file became broken, but due to the above I cannot pinpoint
the commit which broke it. Sorry.
I'll happily test any change you or Helmut or anyone else suggests.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 14:33 ` Eli Zaretskii
@ 2024-06-14 14:46 ` Gerd Möllmann
0 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 14:46 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> I'd probably put a breakpoitn in mirror_fwd and look around if something
>> there is not right for IA32, or Windows, don't know.
>
> Thanks. But this kind of journey down the rabbit hole (mirror_fwd
> leads to IGC_MIRROR_OBJ, which leads to mirror_lisp_obj, which leads
> to look up_copy and a bunch of other functions whose functionality is
> not documented anywhere) will have to wait for someone else. Sorry, I
> have too much on my plate at this time: need to start the Emacs 30
> release cycle.
>
> I can only say that I tried to bisect your changes installed today,
> and failed: almost all of the commits between 219f7d5 (the last one
> which builds and works) and HEAD don't even compile due to compilation
> errors (undeclared variables, missing functions, etc.), and those
> which do compile crash when Emacs attempts to byte-compile some Lisp.
> My guess is that something very basic in dumping and/or loading from
> the pdumper file became broken, but due to the above I cannot pinpoint
> the commit which broke it. Sorry.
Yeah, that's the joy of not working in unrelated branches in two repos.
The commits build in the original, but not without fixes when patched
into the other repo.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 11:32 ` Eli Zaretskii
2024-06-14 12:43 ` Gerd Möllmann
@ 2024-06-14 16:30 ` Helmut Eller
2024-06-14 18:28 ` Eli Zaretskii
1 sibling, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-14 16:30 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: gerd.moellmann, acorallo, emacs-devel
> Does the current branch build on GNU/Linus
> as a 32-bit executable?
Yes, it builds here. At least the tty version.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 16:30 ` Helmut Eller
@ 2024-06-14 18:28 ` Eli Zaretskii
2024-06-14 19:03 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 18:28 UTC (permalink / raw)
To: Helmut Eller; +Cc: gerd.moellmann, acorallo, emacs-devel
> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: gerd.moellmann@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 18:30:17 +0200
>
> > Does the current branch build on GNU/Linus
> > as a 32-bit executable?
>
> Yes, it builds here. At least the tty version.
Too bad. This means the problem is probably Windows-specific, and
thus will probably remain unsolved (and make this branch not very
interesting for me).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 18:28 ` Eli Zaretskii
@ 2024-06-14 19:03 ` Eli Zaretskii
2024-06-14 19:26 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-14 19:03 UTC (permalink / raw)
To: eller.helmut, gerd.moellmann; +Cc: acorallo, emacs-devel
> Date: Fri, 14 Jun 2024 21:28:57 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: gerd.moellmann@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
>
> > From: Helmut Eller <eller.helmut@gmail.com>
> > Cc: gerd.moellmann@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> > Date: Fri, 14 Jun 2024 18:30:17 +0200
> >
> > > Does the current branch build on GNU/Linus
> > > as a 32-bit executable?
> >
> > Yes, it builds here. At least the tty version.
>
> Too bad. This means the problem is probably Windows-specific
Can the fact that Emacs on Windows uses its own implementation of
malloc explain this problem?
More generally, what exactly has been changed wrt loading from the
pdumper file since commit 219f7d5?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 19:03 ` Eli Zaretskii
@ 2024-06-14 19:26 ` Helmut Eller
2024-06-14 19:50 ` Gerd Möllmann
2024-06-15 6:11 ` Eli Zaretskii
0 siblings, 2 replies; 62+ messages in thread
From: Helmut Eller @ 2024-06-14 19:26 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: gerd.moellmann, acorallo, emacs-devel
On Fri, Jun 14 2024, Eli Zaretskii wrote:
>> Too bad. This means the problem is probably Windows-specific
>
> Can the fact that Emacs on Windows uses its own implementation of
> malloc explain this problem?
Seems unlikely to me.
> More generally, what exactly has been changed wrt loading from the
> pdumper file since commit 219f7d5?
The file is first loaded (mostly) as before; then all objects from the
hot section are copied to a MPS managed region. Finally the hot section
is discarded.
My hypothesis is that discard_dump is the problem. The hot section
probably contains something that isn't properly copied and
dump_discard_mem seems to be a bit different on Windows. Why it even
works on Linux is a mystery to me :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 19:26 ` Helmut Eller
@ 2024-06-14 19:50 ` Gerd Möllmann
2024-06-15 6:26 ` Eli Zaretskii
2024-06-15 6:11 ` Eli Zaretskii
1 sibling, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-14 19:50 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
> My hypothesis is that discard_dump is the problem. The hot section
> probably contains something that isn't properly copied and
> dump_discard_mem seems to be a bit different on Windows. Why it even
> works on Linux is a mystery to me :-).
Pdumper can use, among other methods, mmap'd files. In that case
munmap'ing could write changes back to disk. So pdumper rather marks the
region as not needed. At least that's how I understand it.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 19:26 ` Helmut Eller
2024-06-14 19:50 ` Gerd Möllmann
@ 2024-06-15 6:11 ` Eli Zaretskii
2024-06-15 7:25 ` Gerd Möllmann
1 sibling, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-15 6:11 UTC (permalink / raw)
To: Helmut Eller; +Cc: gerd.moellmann, acorallo, emacs-devel
> From: Helmut Eller <eller.helmut@gmail.com>
> Cc: gerd.moellmann@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 21:26:37 +0200
>
> On Fri, Jun 14 2024, Eli Zaretskii wrote:
>
> > More generally, what exactly has been changed wrt loading from the
> > pdumper file since commit 219f7d5?
>
> The file is first loaded (mostly) as before; then all objects from the
> hot section are copied to a MPS managed region. Finally the hot section
> is discarded.
Can't we instead tell MPS not to move or manage any objects loaded
from the pdumper file? That's basically what we do now on master: any
object loaded from the pdumper file is considered immutable.
> My hypothesis is that discard_dump is the problem. The hot section
> probably contains something that isn't properly copied and
> dump_discard_mem seems to be a bit different on Windows. Why it even
> works on Linux is a mystery to me :-).
The Windows code decommits the memory region and makes it
inaccessible. By contrast, the posix_madvise method is AFAIU just an
advisory, and doesn't necessarily make the memory inaccessible.
Moreover, the Linux man page says:
In glibc, this function is implemented using madvise(2).
However, since glibc 2.6, POSIX_MADV_DONTNEED is treated as a no-
op, because the corresponding madvise(2) value, MADV_DONTNEED,
has destructive semantics.
So to do on Posix systems the same as we do on Windows, I think we
need to call madvise with MADV_DONTNEED, even if posix_madvise is
available, and also call mmap with PROT_NONE. Do you agree? If we do
that, does the GNU/Linux build still work, or does it also crash on
startup?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-14 19:50 ` Gerd Möllmann
@ 2024-06-15 6:26 ` Eli Zaretskii
2024-06-15 7:10 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-15 6:26 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Fri, 14 Jun 2024 21:50:26 +0200
>
> Helmut Eller <eller.helmut@gmail.com> writes:
>
> > My hypothesis is that discard_dump is the problem. The hot section
> > probably contains something that isn't properly copied and
> > dump_discard_mem seems to be a bit different on Windows. Why it even
> > works on Linux is a mystery to me :-).
>
> Pdumper can use, among other methods, mmap'd files. In that case
> munmap'ing could write changes back to disk. So pdumper rather marks the
> region as not needed. At least that's how I understand it.
But it doesn't protect the region from being accessed, AFAIU. By
contrast, on MS-Windows we do this:
(void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
which will then cause an access violation if any address within the
region is accessed in any way (read or write). If you do the same
with mmap and PROT_NONE, does the build still work and does the built
Emacs succeed to start?
Note that originally pdumper.c called dump_discard_mem only for
sections considered discardable:
sections[DS_DISCARDABLE].spec = (struct dump_memory_map_spec)
{
.fd = dump_fd,
.size = header->cold_start - adj_discardable_start,
.offset = adj_discardable_start,
.protection = DUMP_MEMORY_ACCESS_READWRITE,
};
[...]
dump_mmap_discard_contents (§ions[DS_DISCARDABLE]);
Whereas the code in igc.c seems to discard all of the memory loaded
from the pdumper file, or am I missing something?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 6:26 ` Eli Zaretskii
@ 2024-06-15 7:10 ` Gerd Möllmann
2024-06-15 7:34 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 7:10 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>, acorallo@gnu.org, emacs-devel@gnu.org
>> Date: Fri, 14 Jun 2024 21:50:26 +0200
>>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>> > My hypothesis is that discard_dump is the problem. The hot section
>> > probably contains something that isn't properly copied and
>> > dump_discard_mem seems to be a bit different on Windows. Why it even
>> > works on Linux is a mystery to me :-).
>>
>> Pdumper can use, among other methods, mmap'd files. In that case
>> munmap'ing could write changes back to disk. So pdumper rather marks the
>> region as not needed. At least that's how I understand it.
>
> But it doesn't protect the region from being accessed, AFAIU. By
> contrast, on MS-Windows we do this:
>
> (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
>
> which will then cause an access violation if any address within the
> region is accessed in any way (read or write). If you do the same
> with mmap and PROT_NONE, does the build still work and does the built
> Emacs succeed to start?
I'd rather if you comment out the discard_dump in igc.c, in mirror_dump
and see if that's the problem. The GDB output you showed give me no hint
to it. The fwd causing the problem should point to Emacs' data segment,
not the dump. The variable is a DEFVAR_BOOL.
> Note that originally pdumper.c called dump_discard_mem only for
> sections considered discardable:
>
> sections[DS_DISCARDABLE].spec = (struct dump_memory_map_spec)
> {
> .fd = dump_fd,
> .size = header->cold_start - adj_discardable_start,
> .offset = adj_discardable_start,
> .protection = DUMP_MEMORY_ACCESS_READWRITE,
> };
> [...]
> dump_mmap_discard_contents (§ions[DS_DISCARDABLE]);
>
> Whereas the code in igc.c seems to discard all of the memory loaded
> from the pdumper file, or am I missing something?
It's the hot section that igc discards. The pdumper can only discard the
relocs which are not longer needed once they have been processed. The
theory is that it's no longer needed since we have made a copy.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 6:11 ` Eli Zaretskii
@ 2024-06-15 7:25 ` Gerd Möllmann
2024-06-15 7:46 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 7:25 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Helmut Eller, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Helmut Eller <eller.helmut@gmail.com>
>> Cc: gerd.moellmann@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
>> Date: Fri, 14 Jun 2024 21:26:37 +0200
>>
>> On Fri, Jun 14 2024, Eli Zaretskii wrote:
>>
>> > More generally, what exactly has been changed wrt loading from the
>> > pdumper file since commit 219f7d5?
>>
>> The file is first loaded (mostly) as before; then all objects from the
>> hot section are copied to a MPS managed region. Finally the hot section
>> is discarded.
>
> Can't we instead tell MPS not to move or manage any objects loaded
> from the pdumper file? That's basically what we do now on master: any
> object loaded from the pdumper file is considered immutable.
The only way to prevent MPS from managing memory is to make it a root.
While roots are scanned, MPS stops the world, i.e. no other threads are
allowed to run. This is of cause bad for pause times, expecially with
the megabytes of the dump. Which is the root of the idea to copy the
dump - improve incremntality, reduce pause times.
>> My hypothesis is that discard_dump is the problem. The hot section
>> probably contains something that isn't properly copied and
>> dump_discard_mem seems to be a bit different on Windows. Why it even
>> works on Linux is a mystery to me :-).
>
> The Windows code decommits the memory region and makes it
> inaccessible. By contrast, the posix_madvise method is AFAIU just an
> advisory, and doesn't necessarily make the memory inaccessible.
> Moreover, the Linux man page says:
>
> In glibc, this function is implemented using madvise(2).
> However, since glibc 2.6, POSIX_MADV_DONTNEED is treated as a no-
> op, because the corresponding madvise(2) value, MADV_DONTNEED,
> has destructive semantics.
>
> So to do on Posix systems the same as we do on Windows, I think we
> need to call madvise with MADV_DONTNEED, even if posix_madvise is
> available, and also call mmap with PROT_NONE. Do you agree? If we do
> that, does the GNU/Linux build still work, or does it also crash on
> startup?
I still think we should first establish that that is indeed the problem.
Please see my other mail.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 7:10 ` Gerd Möllmann
@ 2024-06-15 7:34 ` Eli Zaretskii
2024-06-15 8:22 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-15 7:34 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: eller.helmut@gmail.com, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Sat, 15 Jun 2024 09:10:42 +0200
>
> >> Pdumper can use, among other methods, mmap'd files. In that case
> >> munmap'ing could write changes back to disk. So pdumper rather marks the
> >> region as not needed. At least that's how I understand it.
> >
> > But it doesn't protect the region from being accessed, AFAIU. By
> > contrast, on MS-Windows we do this:
> >
> > (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
> >
> > which will then cause an access violation if any address within the
> > region is accessed in any way (read or write). If you do the same
> > with mmap and PROT_NONE, does the build still work and does the built
> > Emacs succeed to start?
>
> I'd rather if you comment out the discard_dump in igc.c, in mirror_dump
> and see if that's the problem.
And if disabling that eliminates the segfault, what will we do then?
IMO, getting Emacs to segfault on all systems due to access to the
discarded pdumper memory is the way forward: it allows all of us
(rather than just me) investigate the invalid access and fix it.
> The fwd causing the problem should point to Emacs' data segment, not
> the dump. The variable is a DEFVAR_BOOL.
Sorry, I don't understand what you mean here. If I can help by
providing some information from my build here, please elaborate.
> > Note that originally pdumper.c called dump_discard_mem only for
> > sections considered discardable:
> >
> > sections[DS_DISCARDABLE].spec = (struct dump_memory_map_spec)
> > {
> > .fd = dump_fd,
> > .size = header->cold_start - adj_discardable_start,
> > .offset = adj_discardable_start,
> > .protection = DUMP_MEMORY_ACCESS_READWRITE,
> > };
> > [...]
> > dump_mmap_discard_contents (§ions[DS_DISCARDABLE]);
> >
> > Whereas the code in igc.c seems to discard all of the memory loaded
> > from the pdumper file, or am I missing something?
>
> It's the hot section that igc discards. The pdumper can only discard the
> relocs which are not longer needed once they have been processed. The
> theory is that it's no longer needed since we have made a copy.
Evidently, something was not done properly while copying, I guess?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 7:25 ` Gerd Möllmann
@ 2024-06-15 7:46 ` Eli Zaretskii
2024-06-15 8:14 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-15 7:46 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Helmut Eller <eller.helmut@gmail.com>, acorallo@gnu.org,
> emacs-devel@gnu.org
> Date: Sat, 15 Jun 2024 09:25:00 +0200
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> > In glibc, this function is implemented using madvise(2).
> > However, since glibc 2.6, POSIX_MADV_DONTNEED is treated as a no-
> > op, because the corresponding madvise(2) value, MADV_DONTNEED,
> > has destructive semantics.
> >
> > So to do on Posix systems the same as we do on Windows, I think we
> > need to call madvise with MADV_DONTNEED, even if posix_madvise is
> > available, and also call mmap with PROT_NONE. Do you agree? If we do
> > that, does the GNU/Linux build still work, or does it also crash on
> > startup?
>
> I still think we should first establish that that is indeed the problem.
> Please see my other mail.
Since you insist: I ifdef'ed away this:
#if 0
/* Release the commit charge for the mapping. */
DWORD old_prot;
(void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
#endif
and, lo and behold, Emacs can now start without a problem.
I hope this establishes the fact that we are still accessing memory
from the "discarded" pdumper block.
Now what?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 7:46 ` Eli Zaretskii
@ 2024-06-15 8:14 ` Gerd Möllmann
2024-06-15 8:38 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 8:14 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> I still think we should first establish that that is indeed the problem.
>> Please see my other mail.
>
> Since you insist: I ifdef'ed away this:
>
> #if 0
> /* Release the commit charge for the mapping. */
> DWORD old_prot;
> (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
> #endif
>
> and, lo and behold, Emacs can now start without a problem.
>
> I hope this establishes the fact that we are still accessing memory
> from the "discarded" pdumper block.
>
> Now what?
Thanks, and sorry, but that felt too much like guessing to me :-). I'll
see if I can come up with something equivalent on my system.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 7:34 ` Eli Zaretskii
@ 2024-06-15 8:22 ` Gerd Möllmann
0 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 8:22 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> The fwd causing the problem should point to Emacs' data segment, not
>> the dump. The variable is a DEFVAR_BOOL.
>
> Sorry, I don't understand what you mean here. If I can help by
> providing some information from my build here, please elaborate.
DEFVAR_BOOL sets the symbol's value to point to a Lisp_Fwd_Bool which
has a pointer to a varioble in Emacs' data segment.
The variable you showed was, IIRC
DEFVAR_BOOL ("inhibit-modification-hooks", inhibit_modification_hooks,
It looked to me as if that pointer was bogus.
Doesn't matter much - with Helmut's new dump loading code everything
will change from the ground up again anyway :-).
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 8:14 ` Gerd Möllmann
@ 2024-06-15 8:38 ` Gerd Möllmann
2024-06-15 8:44 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 8:38 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> I still think we should first establish that that is indeed the problem.
>>> Please see my other mail.
>>
>> Since you insist: I ifdef'ed away this:
>>
>> #if 0
>> /* Release the commit charge for the mapping. */
>> DWORD old_prot;
>> (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
>> #endif
>>
>> and, lo and behold, Emacs can now start without a problem.
>>
>> I hope this establishes the fact that we are still accessing memory
>> from the "discarded" pdumper block.
>>
>> Now what?
>
> Thanks, and sorry, but that felt too much like guessing to me :-). I'll
> see if I can come up with something equivalent on my system.
Erm, I can't -
void
dump_discard_mem (void *mem, size_t size)
{
#if VM_SUPPORTED == VM_MS_WINDOWS
/* Discard COWed pages. */
(void) VirtualFree (mem, size, MEM_DECOMMIT);
/* Release the commit charge for the mapping. */
DWORD old_prot;
(void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
#elif VM_SUPPORTED == VM_POSIX
# ifdef HAVE_POSIX_MADVISE
/* Discard COWed pages. */
(void) posix_madvise (mem, size, POSIX_MADV_DONTNEED);
# elif defined HAVE_MADVISE
(void) madvise (mem, size, MADV_DONTNEED);
#endif
/* Release the commit charge for the mapping. */
(void) mprotect (mem, size, PROT_NONE);
#endif
}
This does already an mprotect PROT_NONE on my system (no permissons at
all), and there is nothing nore I can do. I can't munmap because that
would write back the changes done by the reloc phase back to the .pdmp
file.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 8:38 ` Gerd Möllmann
@ 2024-06-15 8:44 ` Helmut Eller
2024-06-15 8:56 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-15 8:44 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, acorallo, emacs-devel
On Sat, Jun 15 2024, Gerd Möllmann wrote:
> I can't munmap because that
> would write back the changes done by the reloc phase back to the .pdmp
> file.
I think that's a misunderstanding. dump_map_file_posix sets MAP_PRIVATE
for DUMP_MEMORY_ACCESS_READWRITE. So whatever changes the reloc phase
makes, they are written to copy-on-write pages and never to disk.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 8:44 ` Helmut Eller
@ 2024-06-15 8:56 ` Gerd Möllmann
2024-06-15 9:07 ` Helmut Eller
2024-06-15 12:33 ` Gerd Möllmann
0 siblings, 2 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 8:56 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
> On Sat, Jun 15 2024, Gerd Möllmann wrote:
>
>> I can't munmap because that
>> would write back the changes done by the reloc phase back to the .pdmp
>> file.
>
> I think that's a misunderstanding. dump_map_file_posix sets MAP_PRIVATE
> for DUMP_MEMORY_ACCESS_READWRITE. So whatever changes the reloc phase
> makes, they are written to copy-on-write pages and never to disk.
Hm, I can try that a bit later. So, the theory would be that mprotect
PROT_NONE does not work somehow on madvice'd not needed memory?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 8:56 ` Gerd Möllmann
@ 2024-06-15 9:07 ` Helmut Eller
2024-06-15 9:27 ` Gerd Möllmann
2024-06-15 12:33 ` Gerd Möllmann
1 sibling, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-15 9:07 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, acorallo, emacs-devel
On Sat, Jun 15 2024, Gerd Möllmann wrote:
> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Sat, Jun 15 2024, Gerd Möllmann wrote:
>>
>>> I can't munmap because that
>>> would write back the changes done by the reloc phase back to the .pdmp
>>> file.
>>
>> I think that's a misunderstanding. dump_map_file_posix sets MAP_PRIVATE
>> for DUMP_MEMORY_ACCESS_READWRITE. So whatever changes the reloc phase
>> makes, they are written to copy-on-write pages and never to disk.
>
> Hm, I can try that a bit later. So, the theory would be that mprotect
> PROT_NONE does not work somehow on madvice'd not needed memory?
It looks like dump_discard_mem doesn't properly check error codes.
Maybe the region it want's to discard is not at page boundaries or
something like that.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 9:07 ` Helmut Eller
@ 2024-06-15 9:27 ` Gerd Möllmann
0 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 9:27 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Good idea!
Sent from my iPhone
> On 15. Jun 2024, at 11:07, Helmut Eller <eller.helmut@gmail.com> wrote:
>
> On Sat, Jun 15 2024, Gerd Möllmann wrote:
>
>> Helmut Eller <eller.helmut@gmail.com> writes:
>>
>>>> On Sat, Jun 15 2024, Gerd Möllmann wrote:
>>>
>>>> I can't munmap because that
>>>> would write back the changes done by the reloc phase back to the .pdmp
>>>> file.
>>>
>>> I think that's a misunderstanding. dump_map_file_posix sets MAP_PRIVATE
>>> for DUMP_MEMORY_ACCESS_READWRITE. So whatever changes the reloc phase
>>> makes, they are written to copy-on-write pages and never to disk.
>>
>> Hm, I can try that a bit later. So, the theory would be that mprotect
>> PROT_NONE does not work somehow on madvice'd not needed memory?
>
> It looks like dump_discard_mem doesn't properly check error codes.
> Maybe the region it want's to discard is not at page boundaries or
> something like that.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 8:56 ` Gerd Möllmann
2024-06-15 9:07 ` Helmut Eller
@ 2024-06-15 12:33 ` Gerd Möllmann
2024-06-16 6:16 ` Gerd Möllmann
1 sibling, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-15 12:33 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> Helmut Eller <eller.helmut@gmail.com> writes:
>
>> On Sat, Jun 15 2024, Gerd Möllmann wrote:
>>
>>> I can't munmap because that
>>> would write back the changes done by the reloc phase back to the .pdmp
>>> file.
>>
>> I think that's a misunderstanding. dump_map_file_posix sets MAP_PRIVATE
>> for DUMP_MEMORY_ACCESS_READWRITE. So whatever changes the reloc phase
>> makes, they are written to copy-on-write pages and never to disk.
>
> Hm, I can try that a bit later. So, the theory would be that mprotect
> PROT_NONE does not work somehow on madvice'd not needed memory?
Indeed, after this change
modified src/pdumper.c
@@ -4931,9 +4931,10 @@ dump_discard_mem (void *mem, size_t size)
(void) posix_madvise (mem, size, POSIX_MADV_DONTNEED);
# elif defined HAVE_MADVISE
(void) madvise (mem, size, MADV_DONTNEED);
-#endif
+# endif
/* Release the commit charge for the mapping. */
- (void) mprotect (mem, size, PROT_NONE);
+ int rc = mprotect (mem, size, PROT_NONE);
+ eassert (rc == 0);
#endif
}
I get
pdumper.c:4937: Emacs fatal error: assertion failed: rc == 0
gmake[3]: *** [Makefile:335: emacs-lisp/byte-opt.elc] Abort trap: 6
gmake[3]: *** Waiting for unfinished jobs....
which is soothing.
I'm reluctant to invest more time though because this all si obsolete
with your change.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-15 12:33 ` Gerd Möllmann
@ 2024-06-16 6:16 ` Gerd Möllmann
2024-06-16 7:53 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-16 6:16 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> pdumper.c:4937: Emacs fatal error: assertion failed: rc == 0
> gmake[3]: *** [Makefile:335: emacs-lisp/byte-opt.elc] Abort trap: 6
> gmake[3]: *** Waiting for unfinished jobs....
>
> which is soothing.
>
> I'm reluctant to invest more time though because this all si obsolete
> with your change.
Just had an inspiration what it might be, and it is indeed the case:
Forwarded symbols are created like this
#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
do { \
static struct Lisp_Objfwd const o_fwd \
= {Lisp_Fwd_Obj, &globals.f_##vname}; \
defvar_lisp_nopro (&o_fwd, lname); \
} while (false)
The pdumper copies these static structs to the dump, and when the dump
is loaded, the symbol's forwarding pointer is changed from pointing to
the static struct to the copy to the dump. Both have the same contents.
IOW, the static structs are no longer used. Consequenlty, when accessing
the structs to get their type (XFWDTYPE) we are accessing something in
the dump.
Why pdumper is doing that escapes me ATM.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-16 6:16 ` Gerd Möllmann
@ 2024-06-16 7:53 ` Eli Zaretskii
2024-06-16 8:19 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-06-16 7:53 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: eller.helmut, acorallo, emacs-devel
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>, acorallo@gnu.org, emacs-devel@gnu.org
> Date: Sun, 16 Jun 2024 08:16:38 +0200
>
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
> > pdumper.c:4937: Emacs fatal error: assertion failed: rc == 0
> > gmake[3]: *** [Makefile:335: emacs-lisp/byte-opt.elc] Abort trap: 6
> > gmake[3]: *** Waiting for unfinished jobs....
> >
> > which is soothing.
> >
> > I'm reluctant to invest more time though because this all si obsolete
> > with your change.
>
> Just had an inspiration what it might be, and it is indeed the case:
>
> Forwarded symbols are created like this
>
> #define DEFVAR_LISP_NOPRO(lname, vname, doc) \
> do { \
> static struct Lisp_Objfwd const o_fwd \
> = {Lisp_Fwd_Obj, &globals.f_##vname}; \
> defvar_lisp_nopro (&o_fwd, lname); \
> } while (false)
>
> The pdumper copies these static structs to the dump, and when the dump
> is loaded, the symbol's forwarding pointer is changed from pointing to
> the static struct to the copy to the dump. Both have the same contents.
>
> IOW, the static structs are no longer used. Consequenlty, when accessing
> the structs to get their type (XFWDTYPE) we are accessing something in
> the dump.
>
> Why pdumper is doing that escapes me ATM.
Because the values recorded during dumping could be different from the
default values, and so using the static struct might be wrong?
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-16 7:53 ` Eli Zaretskii
@ 2024-06-16 8:19 ` Gerd Möllmann
2024-06-16 8:40 ` Helmut Eller
0 siblings, 1 reply; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-16 8:19 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: eller.helmut, acorallo, emacs-devel
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>, acorallo@gnu.org, emacs-devel@gnu.org
>> Date: Sun, 16 Jun 2024 08:16:38 +0200
>>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>> > pdumper.c:4937: Emacs fatal error: assertion failed: rc == 0
>> > gmake[3]: *** [Makefile:335: emacs-lisp/byte-opt.elc] Abort trap: 6
>> > gmake[3]: *** Waiting for unfinished jobs....
>> >
>> > which is soothing.
>> >
>> > I'm reluctant to invest more time though because this all si obsolete
>> > with your change.
>>
>> Just had an inspiration what it might be, and it is indeed the case:
>>
>> Forwarded symbols are created like this
>>
>> #define DEFVAR_LISP_NOPRO(lname, vname, doc) \
>> do { \
>> static struct Lisp_Objfwd const o_fwd \
>> = {Lisp_Fwd_Obj, &globals.f_##vname}; \
>> defvar_lisp_nopro (&o_fwd, lname); \
>> } while (false)
>>
>> The pdumper copies these static structs to the dump, and when the dump
>> is loaded, the symbol's forwarding pointer is changed from pointing to
>> the static struct to the copy to the dump. Both have the same contents.
>>
>> IOW, the static structs are no longer used. Consequenlty, when accessing
>> the structs to get their type (XFWDTYPE) we are accessing something in
>> the dump.
>>
>> Why pdumper is doing that escapes me ATM.
>
> Because the values recorded during dumping could be different from the
> default values, and so using the static struct might be wrong?
I don't know, it makes no sense to me.
The only values the static struct contains is the type (Lisp_Fwd_Obj in
the example above, and the pointer to the variable we forward to
(&globals.f##vname in the example). I don't understand how these could
be not be right in the static struct if the dumper just left them alone.
I'd even assume that things would go haywire if the copy in the dump
didn't have the exact same values that the static struct has. Confusing.
@Helmut: forgot to mention that explicitly, but I think that might be
relevant to what you are planning to do...
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-16 8:19 ` Gerd Möllmann
@ 2024-06-16 8:40 ` Helmut Eller
2024-06-16 8:49 ` Gerd Möllmann
0 siblings, 1 reply; 62+ messages in thread
From: Helmut Eller @ 2024-06-16 8:40 UTC (permalink / raw)
To: Gerd Möllmann; +Cc: Eli Zaretskii, acorallo, emacs-devel
On Sun, Jun 16 2024, Gerd Möllmann wrote:
> @Helmut: forgot to mention that explicitly, but I think that might be
> relevant to what you are planning to do...
Yes, I already restored the IGC_OBJ_DUMPED_FWD objects. At the moment,
those are all collected on the first GC flip. I reached a point where
there are no gaps in the dump and igc-info etc. can scan it. There are
some other things in the cold section, like the text of buffers, that I
need to either pin or trace.
^ permalink raw reply [flat|nested] 62+ messages in thread
* Re: MPS codegen
2024-06-16 8:40 ` Helmut Eller
@ 2024-06-16 8:49 ` Gerd Möllmann
0 siblings, 0 replies; 62+ messages in thread
From: Gerd Möllmann @ 2024-06-16 8:49 UTC (permalink / raw)
To: Helmut Eller; +Cc: Eli Zaretskii, acorallo, emacs-devel
Helmut Eller <eller.helmut@gmail.com> writes:
> On Sun, Jun 16 2024, Gerd Möllmann wrote:
>
>> @Helmut: forgot to mention that explicitly, but I think that might be
>> relevant to what you are planning to do...
>
> Yes, I already restored the IGC_OBJ_DUMPED_FWD objects. At the moment,
> those are all collected on the first GC flip. I reached a point where
> there are no gaps in the dump and igc-info etc. can scan it. There are
> some other things in the cold section, like the text of buffers, that I
> need to either pin or trace.
Wow, nice! :-)
^ permalink raw reply [flat|nested] 62+ messages in thread
end of thread, other threads:[~2024-06-16 8:49 UTC | newest]
Thread overview: 62+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-06-10 13:39 MPS: Update Gerd Möllmann
2024-06-10 16:17 ` Andrea Corallo
2024-06-10 16:26 ` Gerd Möllmann
2024-06-10 16:44 ` Gerd Möllmann
2024-06-10 20:58 ` Andrea Corallo
2024-06-11 3:12 ` Gerd Möllmann
2024-06-11 20:35 ` Helmut Eller
2024-06-12 4:45 ` Gerd Möllmann
2024-06-12 7:54 ` Eli Zaretskii
2024-06-12 8:00 ` Gerd Möllmann
2024-06-13 9:07 ` MPS codegen (was: MPS: Update) Helmut Eller
2024-06-13 12:33 ` MPS codegen Gerd Möllmann
2024-06-13 17:48 ` Helmut Eller
2024-06-13 18:24 ` Gerd Möllmann
2024-06-13 18:31 ` Gerd Möllmann
2024-06-13 18:38 ` Helmut Eller
2024-06-13 18:54 ` Gerd Möllmann
2024-06-13 19:15 ` Helmut Eller
2024-06-13 19:37 ` Gerd Möllmann
2024-06-14 6:37 ` Eli Zaretskii
2024-06-14 7:30 ` Gerd Möllmann
2024-06-14 7:56 ` Gerd Möllmann
2024-06-14 10:52 ` Eli Zaretskii
2024-06-14 10:46 ` Eli Zaretskii
2024-06-13 23:09 ` Andrea Corallo
2024-06-14 6:08 ` Gerd Möllmann
2024-06-14 7:45 ` Helmut Eller
2024-06-14 7:59 ` Gerd Möllmann
2024-06-14 8:28 ` Gerd Möllmann
2024-06-14 8:51 ` Helmut Eller
2024-06-14 11:32 ` Eli Zaretskii
2024-06-14 12:43 ` Gerd Möllmann
2024-06-14 13:04 ` Eli Zaretskii
2024-06-14 13:17 ` Gerd Möllmann
2024-06-14 13:46 ` Eli Zaretskii
2024-06-14 14:05 ` Gerd Möllmann
2024-06-14 14:33 ` Eli Zaretskii
2024-06-14 14:46 ` Gerd Möllmann
2024-06-14 16:30 ` Helmut Eller
2024-06-14 18:28 ` Eli Zaretskii
2024-06-14 19:03 ` Eli Zaretskii
2024-06-14 19:26 ` Helmut Eller
2024-06-14 19:50 ` Gerd Möllmann
2024-06-15 6:26 ` Eli Zaretskii
2024-06-15 7:10 ` Gerd Möllmann
2024-06-15 7:34 ` Eli Zaretskii
2024-06-15 8:22 ` Gerd Möllmann
2024-06-15 6:11 ` Eli Zaretskii
2024-06-15 7:25 ` Gerd Möllmann
2024-06-15 7:46 ` Eli Zaretskii
2024-06-15 8:14 ` Gerd Möllmann
2024-06-15 8:38 ` Gerd Möllmann
2024-06-15 8:44 ` Helmut Eller
2024-06-15 8:56 ` Gerd Möllmann
2024-06-15 9:07 ` Helmut Eller
2024-06-15 9:27 ` Gerd Möllmann
2024-06-15 12:33 ` Gerd Möllmann
2024-06-16 6:16 ` Gerd Möllmann
2024-06-16 7:53 ` Eli Zaretskii
2024-06-16 8:19 ` Gerd Möllmann
2024-06-16 8:40 ` Helmut Eller
2024-06-16 8:49 ` Gerd Möllmann
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.