MPS: dangling markers

MPS: dangling markers

[Ihor Radchenko]

Related: bug#71644, bug#63040

When running the scratch/igc branch, I noticed a severe slowdown (10x or
more) of redisplay on my large Org buffers.

- The redisplay manifests itself as I build agenda multiple times
  (agenda creates many new markers).

- perf points to (1) itree lookup; (2) bytepos<->charpos, which implies
  that things may be related to the number of allocated markers and
  overlays.

- I observe things slowing down as the number of "PVEC_MARKER" in the
  output of `igc-info' grows.

- Forcing (igc--collect) returns speed to normal

I believe that my observation reveals one important point that may need
to be considered when using MPS: 

We may need to more careful about cases in Emacs C code that traverse
object lists that may contain unreferenced objects.  Because MPS does
not perform GC as regularly as the traditional mark-and-sweep, some
unreferenced objects may remain live and present in internal data
structures for a long time.

AFAIK, at least overlays, buffers, and markers are used in C code within
object lists/trees are often traversed in full. If objects in these
lists are not regularly garbage-collected, we may end up in situation
when dead objects significantly impact performance. I believe that what
I observe locally is exactly the described scenario.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Stefan Monnier]

> - perf points to (1) itree lookup; (2) bytepos<->charpos, which implies
>   that things may be related to the number of allocated markers and
>   overlays.
> - I observe things slowing down as the number of "PVEC_MARKER" in the
>   output of `igc-info' grows.
> - Forcing (igc--collect) returns speed to normal
[...]
> AFAIK, at least overlays, buffers, and markers are used in C code within
> object lists/trees are often traversed in full. If objects in these
> lists are not regularly garbage-collected, we may end up in situation
> when dead objects significantly impact performance.

AFAIK, markers are the only one that can be reachable (i.e. we may
spend time looking at them) yet GC-able, because the buffers' `markers`
slot contains a linked-list of all markers that's treated specially by
the GC (basically, the list is "weak" so markers get removed from this
list during GC if the marker is reachable only from the list).

[ Of course, similar things can occur with other objects via our weak
  hash table.  And there are a few other "background cleanups" we do in
  GC (such as resizing gaps or truncating undo logs) which could be
  impacted as well.  ]

So I'm not surprised by your point (2) above, but I don't have an
explanation for your point (1), OTOH.

BTW, a lof of C and ELisp code is careful to delete markers after their
use, so I suspect that a large proportion of the "dead" markers that can
accumulate in the list of markers are those created by the chars<->bytes
conversion code (as a memoization cache), and we should be able to
decouple their collection from the GC by simply adding a bit that says
this is just a cached result of a previous chars<->bytes conversion,
rather than a true marker object, and then we could have a "background
task" that flushes them as needed.


        Stefan

Re: MPS: dangling markers

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> - perf points to (1) itree lookup; (2) bytepos<->charpos, which implies
>>   that things may be related to the number of allocated markers and
>>   overlays.
>> - I observe things slowing down as the number of "PVEC_MARKER" in the
>>   output of `igc-info' grows.
>> - Forcing (igc--collect) returns speed to normal
> [...]
>> AFAIK, at least overlays, buffers, and markers are used in C code within
>> object lists/trees are often traversed in full. If objects in these
>> lists are not regularly garbage-collected, we may end up in situation
>> when dead objects significantly impact performance.
>
> AFAIK, markers are the only one that can be reachable (i.e. we may
> spend time looking at them) yet GC-able, because the buffers' `markers`
> slot contains a linked-list of all markers that's treated specially by
> the GC (basically, the list is "weak" so markers get removed from this
> list during GC if the marker is reachable only from the list).

Exactly.

> [ Of course, similar things can occur with other objects via our weak
>   hash table.  And there are a few other "background cleanups" we do in
>   GC (such as resizing gaps or truncating undo logs) which could be
>   impacted as well.  ]

(FWIW, in igc, I'm trying to do these things incrementally when idle,
Weaj hash tables are currently not implemented. I can't bring me to do
that.)

> So I'm not surprised by your point (2) above, but I don't have an
> explanation for your point (1), OTOH.

Would be interesting to so some profiler output showing in which context
these itree operations happen.

> BTW, a lof of C and ELisp code is careful to delete markers after their
> use, so I suspect that a large proportion of the "dead" markers that can
> accumulate in the list of markers are those created by the chars<->bytes
> conversion code (as a memoization cache), and we should be able to
> decouple their collection from the GC by simply adding a bit that says
> this is just a cached result of a previous chars<->bytes conversion,
> rather than a true marker object, and then we could have a "background
> task" that flushes them as needed.

That might be a way, yes. In igc I could try to do that in on_idle,
incrementally, or even in another thread (not the Emacs ones).

Re: MPS: dangling markers

[Ihor Radchenko]

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

>> AFAIK, markers are the only one that can be reachable (i.e. we may
>> spend time looking at them) yet GC-able, because the buffers' `markers`
>> slot contains a linked-list of all markers that's treated specially by
>> the GC (basically, the list is "weak" so markers get removed from this
>> list during GC if the marker is reachable only from the list).
>
> Exactly.

I looked closer into the version of buf_charpos_to_bytepos in
scratch/igc, and I notice that

# define DO_MARKERS(b, m)                                                  \
  for (struct marker_it it_ = marker_it_init (b); marker_it_valid (&it_); \
       marker_it_next (&it_)) \
    for (struct Lisp_Marker *m = marker_it_marker (&it_); m; m = NULL)

is a double loop, which is different from version of master (master has
a single for loop).

Inside the loop body, we have

      /* If we are down to a range of 50 chars,
	 don't bother checking any other markers;
	 scan the intervening chars directly now.  */
      if (best_above - charpos < distance
          || charpos - best_below < distance)
	break;

which will break out only from the inner loop, continuing traversal over
the full marker list.

(I cannot test it for the time being because the latest scratch/igc does
not compile for me)

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> AFAIK, markers are the only one that can be reachable (i.e. we may
>>> spend time looking at them) yet GC-able, because the buffers' `markers`
>>> slot contains a linked-list of all markers that's treated specially by
>>> the GC (basically, the list is "weak" so markers get removed from this
>>> list during GC if the marker is reachable only from the list).
>>
>> Exactly.
>
> I looked closer into the version of buf_charpos_to_bytepos in
> scratch/igc, and I notice that
>
> # define DO_MARKERS(b, m)                                                  \
>   for (struct marker_it it_ = marker_it_init (b); marker_it_valid (&it_); \
>        marker_it_next (&it_)) \
>     for (struct Lisp_Marker *m = marker_it_marker (&it_); m; m = NULL)
>
> is a double loop, which is different from version of master (master has
> a single for loop).

It's only a syntactic trick to get M declared. Please note that the
inner for runs exactly onee.

Re: MPS: dangling markers

[Ihor Radchenko]

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

>>   for (struct marker_it it_ = marker_it_init (b); marker_it_valid (&it_); \
>>        marker_it_next (&it_)) \
>>     for (struct Lisp_Marker *m = marker_it_marker (&it_); m; m = NULL)
>>
>> is a double loop, which is different from version of master (master has
>> a single for loop).
>
> It's only a syntactic trick to get M declared. Please note that the
> inner for runs exactly onee.

But when we have for (...) for (...) break;, the break will only stop
the inner loop, no?

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>>   for (struct marker_it it_ = marker_it_init (b); marker_it_valid (&it_); \
>>>        marker_it_next (&it_)) \
>>>     for (struct Lisp_Marker *m = marker_it_marker (&it_); m; m = NULL)
>>>
>>> is a double loop, which is different from version of master (master has
>>> a single for loop).
>>
>> It's only a syntactic trick to get M declared. Please note that the
>> inner for runs exactly onee.
>
> But when we have for (...) for (...) break;, the break will only stop
> the inner loop, no?

Oh, that's right. Didn't think of that... Shit. Emacs should use C++ so
that one can write real iterators :-(.

Maybe you can also tell me what the compilation error is?

Re: MPS: dangling markers

[Ihor Radchenko]

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

>> But when we have for (...) for (...) break;, the break will only stop
>> the inner loop, no?
>
> Oh, that's right. Didn't think of that... Shit. Emacs should use C++ so
> that one can write real iterators :-(.

You only fixed one place where break is used inside DO_MARKERS. But
there are two such places ;)

> Maybe you can also tell me what the compilation error is?

make -j9 boostrap:

make[2]: Leaving directory '/home/yantar92/Git/emacs'
make actual-all
make[2]: Entering directory '/home/yantar92/Git/emacs'
make -C lib all
make -C doc/lispref info
make -C doc/lispintro info
make -C doc/emacs info
make[3]: Entering directory '/home/yantar92/Git/emacs/doc/lispintro'
/bin/mkdir -p ../../info
make[3]: Entering directory '/home/yantar92/Git/emacs/doc/lispref'
/bin/mkdir -p ../../info
  GEN      ../../info/eintr.info
  GEN      info/dir
cp elisp_type_hierarchy.txt ../../info/elisp_type_hierarchy.txt
cp elisp_type_hierarchy.jpg ../../info/elisp_type_hierarchy.jpg
make[3]: Entering directory '/home/yantar92/Git/emacs/doc/emacs'
  GEN      ../../info/emacs.info
  GEN      ../../info/elisp.info
make[3]: Entering directory '/home/yantar92/Git/emacs/lib'
  GEN      alloca.h
  GEN      dirent.h
  GEN      fcntl.h
  GEN      inttypes.h
  GEN      limits.h
  GEN      signal.h
  GEN      stddef.h
  GEN      stdio.h
  GEN      stdlib.h
  GEN      string.h
  GEN      sys/random.h
  GEN      sys/select.h
  GEN      sys/stat.h
  GEN      sys/time.h
  GEN      sys/types.h
  GEN      time.h
  GEN      unistd.h
  CC       fingerprint.o
  CC       acl-errno-valid.o
  CC       acl-internal.o
  CC       get-permissions.o
  CC       set-permissions.o
  CC       allocator.o
  CC       binary-io.o
  CC       boot-time.o
  CC       c-ctype.o
  CC       c-strcasecmp.o
  CC       c-strncasecmp.o
  CC       careadlinkat.o
  CC       close-stream.o
  CC       copy-file-range.o
  CC       md5-stream.o
  CC       md5.o
  CC       sha1.o
  CC       sha256.o
  CC       sha512.o
  CC       dtoastr.o
  CC       dtotimespec.o
  CC       fcntl.o
  CC       file-has-acl.o
  CC       filemode.o
  CC       filevercmp.o
  CC       fsusage.o
  CC       gettime.o
  CC       memset_explicit.o
  CC       nanosleep.o
  CC       nproc.o
  CC       nstrftime.o
  CC       pipe2.o
  CC       qcopy-acl.o
  CC       sig2str.o
  CC       stat-time.o
  CC       tempname.o
  CC       time_rz.o
  CC       timespec.o
  CC       timespec-add.o
  CC       timespec-sub.o
  CC       u64.o
  CC       unistd.o
  CC       openat-die.o
  CC       save-cwd.o
  AR       libgnu.a
make[3]: Leaving directory '/home/yantar92/Git/emacs/lib'
make -C lib-src all
make[3]: Entering directory '/home/yantar92/Git/emacs/lib-src'
  CCLD     etags
  CCLD     ctags
  CCLD     emacsclient
  CCLD     ebrowse
  CCLD     hexl
  CC       pop.o
  CCLD     make-docfile
  CCLD     make-fingerprint
  CCLD     seccomp-filter
  CCLD     movemail
  GEN      seccomp-filter.bpf
  GEN      seccomp-filter-exec.bpf
make[3]: Leaving directory '/home/yantar92/Git/emacs/lib-src'
make -C src BIN_DESTDIR=''/usr/local/bin/'' \
	ELN_DESTDIR='/usr/local/lib/emacs/31.0.50/' all
make[3]: Entering directory '/home/yantar92/Git/emacs/src'
  GEN      globals.h
  GEN      buildobj.h
make -C ../admin/charsets all
make -C ../admin/unidata charscript.el
make[4]: Entering directory '/home/yantar92/Git/emacs/admin/unidata'
make -C ../admin/unidata emoji-zwj.el
make -C ../admin/charsets cp51932.el
make[4]: Entering directory '/home/yantar92/Git/emacs/admin/unidata'
make[4]: Entering directory '/home/yantar92/Git/emacs/admin/charsets'
make[4]: Nothing to be done for 'cp51932.el'.
make[4]: Leaving directory '/home/yantar92/Git/emacs/admin/charsets'
make -C ../admin/charsets eucjp-ms.el
make[4]: Entering directory '/home/yantar92/Git/emacs/admin/charsets'
make[4]: Nothing to be done for 'eucjp-ms.el'.
make[4]: Leaving directory '/home/yantar92/Git/emacs/admin/charsets'
make[4]: Nothing to be done for 'emoji-zwj.el'.
make[4]: Leaving directory '/home/yantar92/Git/emacs/admin/unidata'
make[4]: Nothing to be done for 'charscript.el'.
make[4]: Leaving directory '/home/yantar92/Git/emacs/admin/unidata'
make[4]: Entering directory '/home/yantar92/Git/emacs/admin/charsets'
make[4]: Nothing to be done for 'all'.
make[4]: Leaving directory '/home/yantar92/Git/emacs/admin/charsets'
  CC       dispnew.o
  CC       frame.o
  CC       scroll.o
  CC       xdisp.o
  CC       menu.o
  CC       xmenu.o
  CC       window.o
  CC       charset.o
  CC       coding.o
  CC       category.o
make[3]: Leaving directory '/home/yantar92/Git/emacs/doc/lispintro'
  CC       ccl.o
  CC       character.o
  CC       chartab.o
  CC       bidi.o
  CC       cm.o
  CC       term.o
  CC       terminal.o
  CC       xfaces.o
  CC       xterm.o
  CC       xfns.o
  CC       xselect.o
  CC       xrdb.o
coding.c: In function ‘decode_coding_charset’:
coding.c:5562:18: warning: potential null pointer dereference [-Wnull-dereference]
 5562 |       if (charset->id != charset_ascii
      |           ~~~~~~~^~~~
  CC       xsmfns.o
  CC       xsettings.o
  CC       gtkutil.o
  CC       emacsgtkfixed.o
  CC       dbusbind.o
  CC       emacs.o
  CC       keyboard.o
  CC       macros.o
  CC       keymap.o
  CC       sysdep.o
  CC       bignum.o
  CC       buffer.o
  CC       filelock.o
  CC       insdel.o
  CC       marker.o
  CC       minibuf.o
  CC       fileio.o
  CC       dired.o
  CC       cmds.o
  CC       casetab.o
  CC       casefiddle.o
  CC       indent.o
  CC       search.o
  CC       regex-emacs.o
  CC       undo.o
  CC       alloc.o
  CC       pdumper.o
  CC       data.o
  CC       doc.o
  CC       editfns.o
  CC       callint.o
  CC       eval.o
  CC       floatfns.o
  CC       fns.o
  CC       sort.o
  CC       font.o
  CC       print.o
  CC       lread.o
  CC       emacs-module.o
  CC       syntax.o
  CC       bytecode.o
  CC       comp.o
  CC       dynlib.o
  CC       process.o
  CC       gnutls.o
  CC       callproc.o
  CC       region-cache.o
  CC       sound.o
  CC       timefns.o
  CC       atimer.o
  CC       doprnt.o
  CC       intervals.o
  CC       textprop.o
make[3]: Leaving directory '/home/yantar92/Git/emacs/doc/emacs'
  CC       composite.o
  CC       xml.o
  CC       lcms.o
  CC       inotify.o
  CC       profiler.o
  CC       decompress.o
  CC       igc.o
  CC       thread.o
  CC       systhread.o
  CC       sqlite.o
  CC       treesit.o
  CC       itree.o
  CC       json.o
  CC       xfont.o
  CC       ftfont.o
  CC       ftcrfont.o
  CC       hbfont.o
  CC       fontset.o
  CC       fringe.o
  CC       image.o
  CC       textconv.o
  CC       xgselect.o
  CC       terminfo.o
  CC       lastfile.o
  CCLD     temacs
  GEN      ../etc/DOC
/bin/mkdir -p ../etc
make -C ../lisp update-subdirs
make[4]: Entering directory '/home/yantar92/Git/emacs/lisp'
make[4]: Leaving directory '/home/yantar92/Git/emacs/lisp'
cp -f temacs bootstrap-emacs
rm -f bootstrap-emacs.pdmp
./temacs --batch  -l loadup --temacs=pbootstrap \
	--bin-dest /usr/local/bin/ --eln-dest /usr/local/lib/emacs/31.0.50/

root.c:294: Emacs fatal error: assertion failed: AddrIsAligned(limit, sizeof(Word))
make[3]: *** [Makefile:1018: bootstrap-emacs.pdmp] Aborted
make[3]: Leaving directory '/home/yantar92/Git/emacs/src'
make[2]: *** [Makefile:554: src] Error 2
make[2]: *** Waiting for unfinished jobs....
make[3]: Leaving directory '/home/yantar92/Git/emacs/doc/lispref'
make[2]: Leaving directory '/home/yantar92/Git/emacs'
make[1]: *** [Makefile:1293: actual-bootstrap] Error 2
make[1]: Leaving directory '/home/yantar92/Git/emacs'
make[1]: Entering directory '/home/yantar92/Git/emacs'
***
*** "make bootstrap" failed with exit status 2.
***
*** You could try to:
*** - run "make extraclean" and run "make" again (or, equivalently, run
***   "make bootstrap configure=default"), to rebuild Emacs with the
***   default configuration options, which might fix the problem
*** - run "git clean -fdx" and run "make bootstrap" again, which might
***   fix the problem if "make bootstrap configure=default" did not
***   !BEWARE! "git clean -fdx" deletes all files that are not under
***   !BEWARE! version control, which means that all changes to such
***   !BEWARE! files will be lost and cannot be restored later
*** - run "make V=1", which displays the full commands invoked by make,
***   to further investigate the problem
*** - report the problem and ask for help by sending an email to
***   bug-gnu-emacs@gnu.org, mentioning at least the build error
***   message, the platform, and the repository revision displayed by
***   "git rev-parse HEAD"
***
make[1]: *** [Makefile:418: advice-on-failure] Error 2
make[1]: Leaving directory '/home/yantar92/Git/emacs'
make: *** [Makefile:1276: bootstrap] Error 2

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> But when we have for (...) for (...) break;, the break will only stop
>>> the inner loop, no?
>>
>> Oh, that's right. Didn't think of that... Shit. Emacs should use C++ so
>> that one can write real iterators :-(.
>
> You only fixed one place where break is used inside DO_MARKERS. But
> there are two such places ;)

Scheiße. Then it has to wait till tomorrow, I'm afraid, because I'm
leaving in a few minutes. Maybe I'll introduce a END_DO_MACRO so that I
don't need for inner for. Or something completely different. Very
unsatisfactory.

>> Maybe you can also tell me what the compilation error is?
>
> make -j9 boostrap:
>
> root.c:294: Emacs fatal error: assertion failed: AddrIsAligned(limit, sizeof(Word))
> make[3]: *** [Makefile:1018: bootstrap-emacs.pdmp] Aborted

That sounds like the PURESIZE thing Helmut and Eli are currently talking
about. You could revert the last commit that refers to pure, I guess.

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> But when we have for (...) for (...) break;, the break will only stop
>>> the inner loop, no?
>>
>> Oh, that's right. Didn't think of that... Shit. Emacs should use C++ so
>> that one can write real iterators :-(.

I've pushed something. Please give it a try.

Re: MPS: dangling markers

[Ihor Radchenko]

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

> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>>> But when we have for (...) for (...) break;, the break will only stop
>>>> the inner loop, no?
>>>
>>> Oh, that's right. Didn't think of that... Shit. Emacs should use C++ so
>>> that one can write real iterators :-(.
>
> I've pushed something. Please give it a try.

Thanks!
The performance is much better now, although still a few times slower
compared to master.

I did a small perf benchmark generating large agendas multiple times,
and got the following output:

    36.34%  emacs         emacs                                          [.] igc_remove_marker
    35.77%  emacs         emacs                                          [.] igc_add_marker
     3.41%  emacs         emacs                                          [.] buf_charpos_to_bytepos
     2.12%  emacs         emacs                                          [.] re_search_2
     1.60%  emacs         emacs                                          [.] re_match_2_internal
     1.13%  emacs         emacs                                          [.] exec_byte_code
     0.95%  emacs         emacs                                          [.] buf_bytepos_to_charpos

I guess O(N) is not all the fast, after all :)

(assoc-string "PVEC_MARKER" (igc-info)) gives ~200-600k markers with my setup.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> I did a small perf benchmark generating large agendas multiple times,
> and got the following output:
>
>     36.34%  emacs         emacs                                          [.] igc_remove_marker
>     35.77%  emacs         emacs                                          [.] igc_add_marker
>      3.41%  emacs         emacs                                          [.] buf_charpos_to_bytepos
>      2.12%  emacs         emacs                                          [.] re_search_2
>      1.60%  emacs         emacs                                          [.] re_match_2_internal
>      1.13%  emacs         emacs                                          [.] exec_byte_code
>      0.95%  emacs         emacs                                          [.] buf_bytepos_to_charpos
>
> I guess O(N) is not all the fast, after all :)

Thanks for testing it, and yeah O(n) isn't that great. Bad is that I
have no idea how to improve that ATM :-/.

Problem is that weak entries can be set to nil, concurrently, while we
are traversing the vector. So, compacting the vector while detecting
dead markers in not an option because that would confuse the iteration.

Easy and clean but expensive would be to make a copy and iterate over
the copy. Especially expensive when we have many markers.

Easy and probably also expensive (unknown) is to stop GCing while
iterating.

Hm, hm, hm.

> (assoc-string "PVEC_MARKER" (igc-info)) gives ~200-600k markers with my setup.

M-x igc-stats RET since yesterday, I believe :-)

How many live and dead? 

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Stefan Monnier <monnier@iro.umontreal.ca>,  emacs-devel@gnu.org,  Eli
>  Zaretskii <eliz@gnu.org>,  eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 16:56:10 +0200
> 
> Ihor Radchenko <yantar92@posteo.net> writes:
> 
> > I did a small perf benchmark generating large agendas multiple times,
> > and got the following output:
> >
> >     36.34%  emacs         emacs                                          [.] igc_remove_marker
> >     35.77%  emacs         emacs                                          [.] igc_add_marker
> >      3.41%  emacs         emacs                                          [.] buf_charpos_to_bytepos
> >      2.12%  emacs         emacs                                          [.] re_search_2
> >      1.60%  emacs         emacs                                          [.] re_match_2_internal
> >      1.13%  emacs         emacs                                          [.] exec_byte_code
> >      0.95%  emacs         emacs                                          [.] buf_bytepos_to_charpos
> >
> > I guess O(N) is not all the fast, after all :)
> 
> Thanks for testing it, and yeah O(n) isn't that great. Bad is that I
> have no idea how to improve that ATM :-/.

I think we can use a completely different data structure for
character-to-byte conversions.  There's no need to use markers for
that, and there's no need to create extra markers.  We could instead
maintain an itree of positions with their character and byte values,
as a field of 'struct buffer' that is not exposed to Lisp.

WDYT?

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Stefan Monnier <monnier@iro.umontreal.ca>,  emacs-devel@gnu.org,  Eli
>>  Zaretskii <eliz@gnu.org>,  eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 16:56:10 +0200
>> 
>> Ihor Radchenko <yantar92@posteo.net> writes:
>> 
>> > I did a small perf benchmark generating large agendas multiple times,
>> > and got the following output:
>> >
>> >     36.34%  emacs         emacs                                          [.] igc_remove_marker
>> >     35.77%  emacs         emacs                                          [.] igc_add_marker
>> >      3.41%  emacs         emacs                                          [.] buf_charpos_to_bytepos
>> >      2.12%  emacs         emacs                                          [.] re_search_2
>> >      1.60%  emacs         emacs                                          [.] re_match_2_internal
>> >      1.13%  emacs         emacs                                          [.] exec_byte_code
>> >      0.95%  emacs         emacs                                          [.] buf_bytepos_to_charpos
>> >
>> > I guess O(N) is not all the fast, after all :)
>> 
>> Thanks for testing it, and yeah O(n) isn't that great. Bad is that I
>> have no idea how to improve that ATM :-/.
>
> I think we can use a completely different data structure for
> character-to-byte conversions.  There's no need to use markers for
> that, and there's no need to create extra markers.  We could instead
> maintain an itree of positions with their character and byte values,
> as a field of 'struct buffer' that is not exposed to Lisp.
>
> WDYT?

I must admit that my overview of that whole area is pretty limited.
I only remember that markers were always kind of a problem :-).

Would such a data structure be similar to recording deletions/insertions
of buffer text? Or, maybe in other words, what would entries contain,
and when would entries be inserted/removed/changed? (Somehow, this
reminds me a bit of a piece table, if you remember, but without holding
the text...)

Anyway, it's a lot of work, of course. So far, with the kind of buffers
I use I don't notice anything. I don't know if the figure of 500K
markers is real, but that sounds erm strange...

Re: MPS: dangling markers

[Gerd Möllmann]

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

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>>> Cc: Stefan Monnier <monnier@iro.umontreal.ca>,  emacs-devel@gnu.org,  Eli
>>>  Zaretskii <eliz@gnu.org>,  eller.helmut@gmail.com
>>> Date: Sat, 29 Jun 2024 16:56:10 +0200
>>> 
>>> Ihor Radchenko <yantar92@posteo.net> writes:
>>> 
>>> > I did a small perf benchmark generating large agendas multiple times,
>>> > and got the following output:
>>> >
>>> >     36.34%  emacs         emacs                                          [.] igc_remove_marker
>>> >     35.77%  emacs         emacs                                          [.] igc_add_marker
>>> >      3.41%  emacs         emacs                                          [.] buf_charpos_to_bytepos
>>> >      2.12%  emacs         emacs                                          [.] re_search_2
>>> >      1.60%  emacs         emacs                                          [.] re_match_2_internal
>>> >      1.13%  emacs         emacs                                          [.] exec_byte_code
>>> >      0.95%  emacs         emacs                                          [.] buf_bytepos_to_charpos
>>> >
>>> > I guess O(N) is not all the fast, after all :)
>>> 
>>> Thanks for testing it, and yeah O(n) isn't that great. Bad is that I
>>> have no idea how to improve that ATM :-/.
>>
>> I think we can use a completely different data structure for
>> character-to-byte conversions.  There's no need to use markers for
>> that, and there's no need to create extra markers.  We could instead
>> maintain an itree of positions with their character and byte values,
>> as a field of 'struct buffer' that is not exposed to Lisp.
>>
>> WDYT?
>
> I must admit that my overview of that whole area is pretty limited.
> I only remember that markers were always kind of a problem :-).
>
> Would such a data structure be similar to recording deletions/insertions
> of buffer text? Or, maybe in other words, what would entries contain,
> and when would entries be inserted/removed/changed? (Somehow, this
> reminds me a bit of a piece table, if you remember, but without holding
> the text...)
>
> Anyway, it's a lot of work, of course. So far, with the kind of buffers
> I use I don't notice anything. I don't know if the figure of 500K
> markers is real, but that sounds erm strange...

And let me add a question: do we know for sure that these markers stem
from char<->byte position code?

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>   eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 19:17:21 +0200
> 
> And let me add a question: do we know for sure that these markers stem
> from char<->byte position code?

By definition, yes: I meant to use this instead of the markers that
the char<->byte position code creates when it finds long stretches of
text without any markers in it.  IOW, this code from marker.c:

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
	 It will last until the next GC.  */
      if (record)
	build_marker (b, best_below, best_below_byte);

(there are 4 such calls in the conversion routines).

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>>   eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 19:17:21 +0200
>> 
>> And let me add a question: do we know for sure that these markers stem
>> from char<->byte position code?
>
> By definition, yes: I meant to use this instead of the markers that
> the char<->byte position code creates when it finds long stretches of
> text without any markers in it.  IOW, this code from marker.c:
>
>       /* If this position is quite far from the nearest known position,
> 	 cache the correspondence by creating a marker here.
> 	 It will last until the next GC.  */
>       if (record)
> 	build_marker (b, best_below, best_below_byte);
>
> (there are 4 such calls in the conversion routines).

Sorry, I've asked not precisely enough. Do we know the percentage of
markers generated by that code? I mean, of the 500K markers Ihor sees,
how many could be spare?

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>   eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 20:02:41 +0200
> 
> Sorry, I've asked not precisely enough. Do we know the percentage of
> markers generated by that code? I mean, of the 500K markers Ihor sees,
> how many could be spare?

I don't know, but a simple instrumentation (or even just a suitably
defined breakpoint) will tell.

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>>   eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 20:02:41 +0200
>> 
>> Sorry, I've asked not precisely enough. Do we know the percentage of
>> markers generated by that code? I mean, of the 500K markers Ihor sees,
>> how many could be spare?
>
> I don't know, but a simple instrumentation (or even just a suitably
> defined breakpoint) will tell.

I think I'll wait for Stefan's gap buffer. That sounds like a really
nice solution.

Re: MPS: dangling markers

[Ihor Radchenko]

Eli Zaretskii <eliz@gnu.org> writes:

>> Sorry, I've asked not precisely enough. Do we know the percentage of
>> markers generated by that code? I mean, of the 500K markers Ihor sees,
>> how many could be spare?
>
> I don't know, but a simple instrumentation (or even just a suitably
> defined breakpoint) will tell.

I looked into this. And it is near 0%. The overwhelming majority of the
markers are created by something else. I mostly saw save_excursion_save
in backtraces - it creates transient markers to save point position.

(gdb) info breakpoints
Num     Type           Disp Enb Address            What
1       breakpoint     keep y   0x00005555557109b2 in terminate_due_to_signal at emacs.c:443
2       breakpoint     keep y   0x00005555556c6fd3 in x_error_quitter at xterm.c:27135
3       breakpoint     keep y   0x0000555555790361 in build_marker at alloc.c:4172
	breakpoint already hit 1000001 times
4       breakpoint     keep y   0x0000555555754f63 in buf_charpos_to_bytepos at marker.c:239
	breakpoint already hit 46 times
	ignore next 999954 hits
5       breakpoint     keep y   0x0000555555755034 in buf_charpos_to_bytepos at marker.c:264
	breakpoint already hit 1 time
	ignore next 999999 hits
6       breakpoint     keep y   0x00005555557543ad in buf_bytepos_to_charpos at marker.c:392
	breakpoint already hit 207 times
	ignore next 999793 hits
7       breakpoint     keep y   0x00005555557544e1 in buf_bytepos_to_charpos at marker.c:420
	breakpoint already hit 10 times
	ignore next 999990 hits

(gdb) bt
#0  build_marker (buf=0x7fffa244c398, charpos=20364002, bytepos=21237470) at alloc.c:4172
#1  0x00005555557a9e87 in Fpoint_marker () at editfns.c:202
#2  0x00005555557b69b5 in save_excursion_save (pdl=0x5555570899e0) at editfns.c:782
#3  0x00005555557bca9c in record_unwind_protect_excursion () at eval.c:3685
#4  0x00007fffdc38ab0a in F6f72672d666f6c642d636f72652d6765742d666f6c64696e672d73706563_org_fold_core_get_folding_spec_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-fold-core-7b3a75f5-f6453a86.eln
#5  0x00005555557bfbb5 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffdf200170) at eval.c:3188
#6  0x0000555555811438 in exec_byte_code (fun=<optimized out>, fun@entry=XIL(0x7fffaf7c7a55), args_template=<optimized out>, 
    args_template@entry=512, nargs=<optimized out>, nargs@entry=2, args=<optimized out>, args@entry=0x7fffffffaa18)
    at /home/yantar92/Git/emacs/src/lisp.h:2267
#7  0x00005555557c20cf in funcall_lambda (fun=XIL(0x7fffaf7c7a55), nargs=nargs@entry=2, arg_vector=arg_vector@entry=0x7fffffffaa18) at eval.c:3277
#8  0x00005555557c2a70 in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffaa18) at eval.c:3069
#9  0x00005555557bd2dc in Ffuncall (nargs=3, args=0x7fffffffaa10) at eval.c:3118
#10 0x00007fffd58949c7 in F6f72672d666f6c642d2d686964652d64726177657273_org_fold__hide_drawers_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-fold-febd34b9-a5010ad7.eln
#11 0x00005555557bfbb5 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffabc8) at eval.c:3188
#12 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffabc8) at eval.c:3065
#13 0x00005555557bd2dc in Ffuncall (nargs=3, args=0x7fffffffabc0) at eval.c:3118
#14 0x00007fffd55f43d3 in F6f72672d6379636c652d686964652d64726177657273_org_cycle_hide_drawers_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-cycle-294d3dae-a0ab16e3.eln
--Type <RET> for more, q to quit, c to continue without paging--c
#15 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffad48) at eval.c:3186
#16 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffad48) at eval.c:3065
#17 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffad40) at eval.c:3118
#18 0x00007fffd55f793b in F6f72672d6379636c652d7365742d737461727475702d7669736962696c697479_org_cycle_set_startup_visibility_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-cycle-294d3dae-a0ab16e3.eln
#19 0x00005555557bfb96 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffaf30) at eval.c:3184
#20 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffaf30) at eval.c:3065
#21 0x00005555557bd2dc in Ffuncall (nargs=1, args=0x7fffffffaf28) at eval.c:3118
#22 0x00007fffd5bc41e3 in F6f72672d6d6f6465_org_mode_0 () at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-mode-90074ef6-84fc27c1.eln
#23 0x00005555557bfb96 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffb2f8) at eval.c:3184
#24 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffb2f8) at eval.c:3065
#25 0x00005555557bd2dc in Ffuncall (nargs=1, args=0x7fffffffb2f0) at eval.c:3118
#26 0x00007fffe026da2e in F7365742d6175746f2d6d6f64652d30_set_auto_mode_0_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#27 0x00005555557bfbb5 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffb478) at eval.c:3188
#28 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffb478) at eval.c:3065
#29 0x00005555557bd2dc in Ffuncall (nargs=3, args=0x7fffffffb470) at eval.c:3118
#30 0x00007fffe026c785 in F7365742d6175746f2d6d6f64652d2d6170706c792d616c697374_set_auto_mode__apply_alist_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#31 0x00005555557bfbcc in funcall_subr (subr=<optimized out>, numargs=numargs@entry=3, args=args@entry=0x7fffffffb638) at eval.c:3190
#32 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=3, args=args@entry=0x7fffffffb638) at eval.c:3065
#33 0x00005555557bd2dc in Ffuncall (nargs=4, args=0x7fffffffb630) at eval.c:3118
#34 0x00007fffe026d6d3 in F7365742d6175746f2d6d6f6465_set_auto_mode_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#35 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffb780) at eval.c:3186
#36 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffb780) at eval.c:3065
#37 0x00005555557bd2dc in Ffuncall (nargs=1, args=0x7fffffffb778) at eval.c:3118
#38 0x00007fffe026bed7 in F6e6f726d616c2d6d6f6465_normal_mode_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#39 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffb8d0) at eval.c:3186
#40 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffb8d0) at eval.c:3065
#41 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffb8c8) at eval.c:3118
#42 0x00007fffe026b19e in F61667465722d66696e642d66696c65_after_find_file_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#43 0x00005555557bfc06 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffba50) at eval.c:3194
#44 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffba50) at eval.c:3065
#45 0x00005555557bd2dc in Ffuncall (nargs=3, args=0x7fffffffba48) at eval.c:3118
#46 0x00007fffe026aa9d in F66696e642d66696c652d6e6f73656c6563742d31_find_file_noselect_1_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#47 0x00005555557bfc29 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=6, args=args@entry=0x7fffffffbbc0) at eval.c:3196
#48 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=6, args=args@entry=0x7fffffffbbc0) at eval.c:3065
#49 0x00005555557bd2dc in Ffuncall (nargs=7, args=0x7fffffffbbb8) at eval.c:3118
#50 0x00007fffe02693c5 in F66696e642d66696c652d6e6f73656c656374_find_file_noselect_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/files-1e8937b2-273c07ee.eln
#51 0x00005555557bfbe7 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=4, args=args@entry=0x7fffdf200110) at eval.c:3192
#52 0x0000555555811438 in exec_byte_code (fun=<optimized out>, fun@entry=XIL(0x7fffadd2bb4d), args_template=<optimized out>, 
    args_template@entry=0, nargs=<optimized out>, nargs@entry=0, args=<optimized out>, args@entry=0x0) at /home/yantar92/Git/emacs/src/lisp.h:2267
#53 0x00005555557c26c8 in funcall_lambda (fun=<optimized out>, nargs=nargs@entry=2, arg_vector=arg_vector@entry=0x7fffdf2000d8) at eval.c:3377
#54 0x00005555557c2a70 in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffdf2000d8) at eval.c:3069
#55 0x00005555557bd2dc in Ffuncall (nargs=nargs@entry=3, args=args@entry=0x7fffdf2000d0) at eval.c:3118
#56 0x00005555557bd687 in Fapply (nargs=3, args=0x7fffdf2000d0) at eval.c:2747
#57 0x00005555557bfcbc in funcall_subr (subr=<optimized out>, numargs=numargs@entry=3, args=args@entry=0x7fffdf2000d0) at eval.c:3209
#58 0x0000555555811438 in exec_byte_code (fun=<optimized out>, fun@entry=XIL(0x7fffad8fd6dd), args_template=<optimized out>, 
    args_template@entry=128, nargs=<optimized out>, nargs@entry=1, args=<optimized out>, args@entry=0x7fffffffc078)
    at /home/yantar92/Git/emacs/src/lisp.h:2267
#59 0x00005555557c20cf in funcall_lambda (fun=XIL(0x7fffad8fd6dd), nargs=nargs@entry=1, arg_vector=arg_vector@entry=0x7fffffffc078) at eval.c:3277
#60 0x00005555557c2a70 in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc078) at eval.c:3069
#61 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffc070) at eval.c:3118
#62 0x00007fffdc205739 in F6f72672d6765742d6167656e64612d66696c652d627566666572_org_get_agenda_file_buffer_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-agenda-files-10896e5c-8b3ebe25.eln
#63 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc1b0) at eval.c:3186
#64 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc1b0) at eval.c:3065
#65 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffc1a8) at eval.c:3118
#66 0x00007fffdc206913 in F6f72672d6167656e64612d707265706172652d62756666657273_org_agenda_prepare_buffers_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-agenda-files-10896e5c-8b3ebe25.eln
#67 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc318) at eval.c:3186
#68 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc318) at eval.c:3065
#69 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffc310) at eval.c:3118
#70 0x00007fffd594d9db in F6f72672d6167656e64612d70726570617265_org_agenda_prepare_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-agenda-mode-f2f07b62-f49d148c.eln
#71 0x00005555557bfba2 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc4d8) at eval.c:3186
#72 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffc4d8) at eval.c:3065
#73 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffc4d0) at eval.c:3118
#74 0x00007fffcbd1bad2 in F6f72672d6167656e64612d6c697374_org_agenda_list_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-agenda-agenda-view-d200505e-7dde6a0e.eln
#75 0x00005555557bfbe7 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffdf200078) at eval.c:3192
#76 0x0000555555811438 in exec_byte_code (fun=<optimized out>, fun@entry=XIL(0x7fffa049085d), args_template=<optimized out>, 
    args_template@entry=0, nargs=<optimized out>, nargs@entry=0, args=<optimized out>, args@entry=0x7fffffffc7d8)
    at /home/yantar92/Git/emacs/src/lisp.h:2267
#77 0x00005555557c20cf in funcall_lambda (fun=XIL(0x7fffa049085d), nargs=nargs@entry=0, arg_vector=arg_vector@entry=0x7fffffffc7d8) at eval.c:3277
#78 0x00005555557c2a70 in funcall_general (fun=<optimized out>, numargs=numargs@entry=0, args=args@entry=0x7fffffffc7d8) at eval.c:3069
#79 0x00005555557bd2dc in Ffuncall (nargs=1, args=0x7fffffffc7d0) at eval.c:3118
#80 0x00005555557c162c in eval_sub (form=<optimized out>) at /home/yantar92/Git/emacs/src/lisp.h:2267
#81 0x00005555557c1f5e in Fprogn (body=<optimized out>) at eval.c:448
#82 0x00005555557c36f8 in Flet (args=<optimized out>) at /home/yantar92/Git/emacs/src/lisp.h:1522
#83 0x00005555557c14ed in eval_sub (form=form@entry=XIL(0x7fffa0490a0b)) at eval.c:2574
#84 0x00005555557c46ac in Feval (form=XIL(0x7fffa0490a0b), lexical=<optimized out>) at eval.c:2482
#85 0x00005555557bfbb5 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffcb78) at eval.c:3188
#86 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffcb78) at eval.c:3065
#87 0x00005555557bd2dc in Ffuncall (nargs=2, args=0x7fffffffcb70) at eval.c:3118
#88 0x00007fffcbcb42c8 in F6f72672d6167656e6461_org_agenda_0 ()
    at /home/yantar92/.emacs.d/eln-cache/31.0.50-27937d9d/org-agenda-dispatch-79b7658d-4369eade.eln
#89 0x00005555557bfbcc in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffdf200048) at eval.c:3190
#90 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffdf200048) at eval.c:3065
#91 0x00005555557bd2dc in Ffuncall (nargs=nargs@entry=2, args=args@entry=0x7fffdf200040) at eval.c:3118
#92 0x00005555557bd687 in Fapply (nargs=2, args=0x7fffdf200040) at eval.c:2747
#93 0x00005555557bfcbc in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffdf200040) at eval.c:3209
#94 0x0000555555811438 in exec_byte_code (fun=<optimized out>, fun@entry=XIL(0x7fff9a43d605), args_template=<optimized out>, 
    args_template@entry=128, nargs=<optimized out>, nargs@entry=1, args=<optimized out>, args@entry=0x7fffffffd000)
    at /home/yantar92/Git/emacs/src/lisp.h:2267
#95 0x00005555557c20cf in funcall_lambda (fun=XIL(0x7fff9a43d605), nargs=nargs@entry=1, arg_vector=arg_vector@entry=0x7fffffffd000) at eval.c:3277
#96 0x00005555557c2a70 in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffd000) at eval.c:3069
#97 0x00005555557bd2dc in Ffuncall (nargs=nargs@entry=2, args=args@entry=0x7fffffffcff8) at eval.c:3118
#98 0x00005555557b7b4b in Ffuncall_interactively (nargs=2, args=0x7fffffffcff8) at callint.c:250
#99 0x00005555557bfcbc in funcall_subr (subr=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffcff8) at eval.c:3209
#100 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=2, args=args@entry=0x7fffffffcff8) at eval.c:3065
#101 0x00005555557bd2dc in Ffuncall (nargs=nargs@entry=3, args=args@entry=0x7fffffffcff0) at eval.c:3118
#102 0x00005555557b9ca2 in Fcall_interactively (function=<optimized out>, record_flag=<optimized out>, keys=<optimized out>) at callint.c:789
#103 0x00007fffe036d91d in F636f6d6d616e642d65786563757465_command_execute_0 ()
    at /home/yantar92/Git/emacs/src/../native-lisp/31.0.50-27937d9d/preloaded/simple-fab5b0cf-7152995e.eln
#104 0x00005555557bfbe7 in funcall_subr (subr=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffd3a8) at eval.c:3192
#105 0x00005555557c28bb in funcall_general (fun=<optimized out>, numargs=numargs@entry=1, args=args@entry=0x7fffffffd3a8) at eval.c:3065
#106 0x00005555557bd2dc in Ffuncall (nargs=nargs@entry=2, args=args@entry=0x7fffffffd3a0) at eval.c:3118
#107 0x000055555572a668 in command_loop_1 () at keyboard.c:1551
#108 0x00005555557bb469 in internal_condition_case
    (bfun=bfun@entry=0x555555729f8c <command_loop_1>, handlers=handlers@entry=XIL(0x90), hfun=hfun@entry=0x55555571a734 <cmd_error>) at eval.c:1629
#109 0x00005555557134b0 in command_loop_2 (handlers=handlers@entry=XIL(0x90)) at keyboard.c:1169
#110 0x00005555557bb368 in internal_catch (tag=tag@entry=XIL(0x12360), func=func@entry=0x555555713489 <command_loop_2>, arg=arg@entry=XIL(0x90))
    at eval.c:1308
#111 0x0000555555713466 in command_loop () at keyboard.c:1147
#112 0x000055555571a219 in recursive_edit_1 () at keyboard.c:755
#113 0x000055555571a58e in Frecursive_edit () at keyboard.c:838
#114 0x0000555555712f37 in main (argc=1, argv=<optimized out>) at emacs.c:2651

Lisp Backtrace:
"org-fold-core-get-folding-spec" (0xdf200170)
"org-fold-folded-p" (0xffffaa18)
"org-fold--hide-drawers" (0xffffabc8)
"org-cycle-hide-drawers" (0xffffad48)
"org-cycle-set-startup-visibility" (0xffffaf30)
"org-mode" (0xffffb2f8)
"set-auto-mode-0" (0xffffb478)
"set-auto-mode--apply-alist" (0xffffb638)
"set-auto-mode" (0xffffb780)
"normal-mode" (0xffffb8d0)
"after-find-file" (0xffffba50)
"find-file-noselect-1" (0xffffbbc0)
0xadd291b8 PVEC_SUBR
"ad-Advice-find-file-noselect" (0xdf2000d8)
"apply" (0xdf2000d0)
"find-file-noselect" (0xffffc078)
"org-get-agenda-file-buffer" (0xffffc1b0)
"org-agenda-prepare-buffers" (0xffffc318)
"org-agenda-prepare" (0xffffc4d8)
"org-agenda-list" (0xdf200078)
0xa0490858 PVEC_CLOSURE
"funcall" (0xffffc7d0)
"let" (0xffffc968)
"eval" (0xffffcb78)
0x9a43d670 PVEC_SUBR
"apply" (0xdf200040)
"org-agenda" (0xffffd000)
"funcall-interactively" (0xffffcff8)
"command-execute" (0xffffd3a8)

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> Sorry, I've asked not precisely enough. Do we know the percentage of
>>> markers generated by that code? I mean, of the 500K markers Ihor sees,
>>> how many could be spare?
>>
>> I don't know, but a simple instrumentation (or even just a suitably
>> defined breakpoint) will tell.
>
> I looked into this. And it is near 0%. The overwhelming majority of the
> markers are created by something else. I mostly saw save_excursion_save
> in backtraces - it creates transient markers to save point position.

Jup, it's point-marker for me. No idea who calls that so often.

Re: MPS: dangling markers

[Pip Cet]

On Saturday, June 29th, 2024 at 21:50, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Ihor Radchenko yantar92@posteo.net writes:
> 
> > Eli Zaretskii eliz@gnu.org writes:
> > 
> > > > Sorry, I've asked not precisely enough. Do we know the percentage of
> > > > markers generated by that code? I mean, of the 500K markers Ihor sees,
> > > > how many could be spare?
> > > 
> > > I don't know, but a simple instrumentation (or even just a suitably
> > > defined breakpoint) will tell.
> > 
> > I looked into this. And it is near 0%. The overwhelming majority of the
> > markers are created by something else. I mostly saw save_excursion_save
> > in backtraces - it creates transient markers to save point position.
> 
> 
> Jup, it's point-marker for me. No idea who calls that so often.

It probably is save_excursion_save -- while save_excursion_restore calls unchain_marker on it when the excursion is over, that's not guaranteed to be near-immediate with the current MPS code, which searches through a potentially long vector until finding the right marker rather than finding it right away because of the LIFO list. So I think that explains why the MPS code is slower...

I think from the point of view of igc.c, it might make most sense to make BUF_MARKERS(buf) a weak hash table once we support those. I've made it a strong hash table for now, and that seems usable, but of course it would leak markers in actual long-running sessions. (Implementing weak hash tables with MPS seems quite difficult, though: you can have only one "dependent object" with strong references per object with weak references, and it cannot be in a moving pool. And since we can't resize objects that may be pinned by ambiguous references, well, the weak hash table implementation would look quite different from the strong hash tables we have).

Of course, Stefan's plan is even better :-)

Also, why does igc-info not walk the weak pool? Isn't that where the problematic markers are?

Pip

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

> (Implementing weak hash tables with MPS seems quite difficult, though:
> you can have only one "dependent object" with strong references per
> object with weak references, 

Yes, the one dependent object is somewhat limiting. I though yesterday
that using something like a weak doubly-linked list could be the
solution for the markers, but that would require 2 dependent objects,
next and prev. Anyway.

> and it cannot be in a moving pool. 

Right. 

> And since we can't resize objects that may be pinned by ambiguous
> references, well, the weak hash table implementation would look quite
> different from the strong hash tables we have).

I thought that, very roughly, the following might be doable:

If we make-hash-table with weak keys and/or values, allocate the
Lisp_Hash_Table from the AWL pool using the weak_strong allocation
point. If neither keys nor values are weak, allocate the hash table from
the default pool.

Allocate the key and the value vector according to the hash table's
weakness either from the strong or weak allocation point, or from the
default pool if the table isn't weak at all. (I've split the
key_and_value vector already in two, but you probably noticed that
already.)

Dependent object of the key and value vectors could be the hash table
itself.

> Of course, Stefan's plan is even better :-)
>
> Also, why does igc-info not walk the weak pool? Isn't that where the
> problematic markers are?

Lazyness, it should walk all pools we have :-). I have that as a todo.
Time to do it, I guess.

The weak pool currently only contains the weak vectors for markers, the
markers themselves live in the default pool.

Re: MPS: dangling markers

[Gerd Möllmann]

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

>> Also, why does igc-info not walk the weak pool? Isn't that where the
>> problematic markers are?
>
> Lazyness, it should walk all pools we have :-). I have that as a todo.
> Time to do it, I guess.

Done.

Re: MPS: dangling markers

[Pip Cet]

On Sunday, June 30th, 2024 at 04:41, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Pip Cet pipcet@protonmail.com writes:
> > (Implementing weak hash tables with MPS seems quite difficult, though:
> > you can have only one "dependent object" with strong references per
> > object with weak references,
> 
> Yes, the one dependent object is somewhat limiting. I though yesterday
> that using something like a weak doubly-linked list could be the
> solution for the markers, but that would require 2 dependent objects,
> next and prev. Anyway.

I checked in the MPS source code (which, I understand, you don't want to modify), and the limit appears to be something that can be raised easily...

> > And since we can't resize objects that may be pinned by ambiguous
> > references, well, the weak hash table implementation would look quite
> > different from the strong hash tables we have).

> I thought that, very roughly, the following might be doable:

I'm afraid that wouldn't be doable in general, though whipping something up for the special case of markers might be easier. If we had a recipe to measure the performance problem, I could benchmark my strong hash table "solution" to see whether it makes sense to pursue that further.

> If we make-hash-table with weak keys and/or values, allocate the
> Lisp_Hash_Table from the AWL pool using the weak_strong allocation
> point. If neither keys nor values are weak, allocate the hash table from
> the default pool.

> Allocate the key and the value vector according to the hash table's
> weakness either from the strong or weak allocation point, or from the
> default pool if the table isn't weak at all. (I've split the
> key_and_value vector already in two, but you probably noticed that
> already.)
> 
> Dependent object of the key and value vectors could be the hash table
> itself.

Then we couldn't modify the value vector when the key gets splatted, or vice versa, so the table wouldn't be properly weak. My understanding is we must allocate all strongly-referencing objects together in one object, all weakly-referencing objects together in another one, and make them depend on each other. And that means making the pseudovec a mere tuple of pointers to the strong and weak parts, because the conglomerate objects might need to be resized...

> The weak pool currently only contains the weak vectors for markers, the
> markers themselves live in the default pool.

Oh, sorry. You're right, of course.

Pip

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

> I checked in the MPS source code (which, I understand, you don't want
> to modify), and the limit appears to be something that can be raised
> easily...

Interesting to hear! (I don't even want to read MPS, only lots of
uninteresting details... :-)).

>> > And since we can't resize objects that may be pinned by ambiguous
>> > references, well, the weak hash table implementation would look quite
>> > different from the strong hash tables we have).
>
>> If we make-hash-table with weak keys and/or values, allocate the
>> Lisp_Hash_Table from the AWL pool using the weak_strong allocation
>> point. If neither keys nor values are weak, allocate the hash table from
>> the default pool.
>
>> Allocate the key and the value vector according to the hash table's
>> weakness either from the strong or weak allocation point, or from the
>> default pool if the table isn't weak at all. (I've split the
>> key_and_value vector already in two, but you probably noticed that
>> already.)
>> 
>> Dependent object of the key and value vectors could be the hash table
>> itself.
>
> Then we couldn't modify the value vector when the key gets splatted,
> or vice versa, so the table wouldn't be properly weak. 

True. I forgot to mention an important thing: When something is splat,
set flag(s) in the dependent hash table indicating that something must
be done because of that splatting. In gethash and so, check the flag and
do what's necessary. (I did something similar for the weak hash tables
in CMUCL, and it wasn't entirely bad. And weak tables should be rare.)

> My understanding is we must allocate all strongly-referencing objects
> together in one object, all weakly-referencing objects together in
> another one, and make them depend on each other. 

The first 2 points I think are true, and are the reason I split the 1
vector in master containing both keys and values into two in igc, so
that keys and values can be weak or not, as necessary.

The 3rd thing you wrote I'm not sure. My understanding is that
specifying a dependent object simply means that MPS makes it accessible
while scanning the depending object. I don't think MPS does anything to
the dependent object by itself. Hence the idea to make the hash table
the dependent object so that one at least can "notify" it that something
has happened, so that it can modify index and next vectors.

> And that means making the pseudovec a mere tuple of pointers to the
> strong and weak parts, because the conglomerate objects might need to
> be resized...

I'm afraid I couldn't follow. Could you please explain?

Re: MPS: dangling markers

[Pip Cet]

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

On Sunday, June 30th, 2024 at 11:02, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Pip Cet pipcet@protonmail.com writes:
> > > > And since we can't resize objects that may be pinned by ambiguous
> > > > references, well, the weak hash table implementation would look quite
> > > > different from the strong hash tables we have).
> >
> > > If we make-hash-table with weak keys and/or values, allocate the
> > > Lisp_Hash_Table from the AWL pool using the weak_strong allocation
> > > point. If neither keys nor values are weak, allocate the hash table from
> > > the default pool.
> >
> > > Allocate the key and the value vector according to the hash table's
> > > weakness either from the strong or weak allocation point, or from the
> > > default pool if the table isn't weak at all. (I've split the
> > > key_and_value vector already in two, but you probably noticed that
> > > already.)
> > >
> > > Dependent object of the key and value vectors could be the hash table
> > > itself.
> >
> > Then we couldn't modify the value vector when the key gets splatted,
> > or vice versa, so the table wouldn't be properly weak.
>
> True. I forgot to mention an important thing: When something is splat,
> set flag(s) in the dependent hash table indicating that something must
> be done because of that splatting. In gethash and so, check the flag and
> do what's necessary. (I did something similar for the weak hash tables
> in CMUCL, and it wasn't entirely bad. And weak tables should be rare.)

Not necessarily rare, particularly not if we turn BUF_MARKERS into a weak hash table (I still don't see why we shouldn't do that, maybe I missed it).

But, yes, that's a good idea and requires far fewer changes to the hash table code than I've now made locally. However, I've decided to go through with it and have just successfully splatted my first weak hash table entry.

> > My understanding is we must allocate all strongly-referencing objects
> > together in one object, all weakly-referencing objects together in
> > another one, and make them depend on each other.
>
>
> The first 2 points I think are true, and are the reason I split the 1
> vector in master containing both keys and values into two in igc, so
> that keys and values can be weak or not, as necessary.
>
> The 3rd thing you wrote I'm not sure. My understanding is that
> specifying a dependent object simply means that MPS makes it accessible
> while scanning the depending object. I don't think MPS does anything to
> the dependent object by itself. Hence the idea to make the hash table
> the dependent object so that one at least can "notify" it that something
> has happened, so that it can modify index and next vectors.

You're right, if we choose to invalidate hash tables asynchronously and fix them up later, it's perfectly okay for the dependent object to be the hash table.

> > And that means making the pseudovec a mere tuple of pointers to the
> > strong and weak parts, because the conglomerate objects might need to
> > be resized...
>
> I'm afraid I couldn't follow. Could you please explain?

If we go with my original proposal (which I'm not at all sure about at this point as the code is really ugly), we'd have to have something like:

struct Lisp_Weak_Hash_Table
{
  union vectorlike_header header;

  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
};

and store everything relevant in ->strong, which would be potentially resized and reallocated by Fputhash.

Another disadvantage of my approach is that if we ever decide to dynamically shrink hash tables, we'd have to have a notification mechanism anyway.

VERY WIP patch attached. It doesn't actually register the dependent object yet or resize the hash tables or anything, it's just enough to build "temacs" (not emacs, the dumper part isn't there yet) and run:

(setq table (make-hash-table :weakness 'key))
(setq key (cons 1 2))
(puthash key (cons 3 4) table)
(gethash key table t)
(hash-table-count table)
(igc--collect)
(setq key nil)
(setq values nil)
(igc--collect)
(hash-table-count table)

and get a 0 result.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-mps-weak-hash-tables.patch --]
[-- Type: text/x-patch; name=0001-mps-weak-hash-tables.patch, Size: 38193 bytes --]

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 2e501005bf7..339614e6639 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -510,11 +510,6 @@ cl--make-usage-var
    (t x)))
 
 (defun cl--make-usage-args (arglist)
-  (let ((aux (ignore-errors (cl-position '&aux arglist))))
-    (when aux
-      ;; `&aux' args aren't arguments, so let's just drop them from the
-      ;; usage info.
-      (setq arglist (cl-subseq arglist 0 aux))))
   (if (not (proper-list-p arglist))
       (let* ((last (last arglist))
              (tail (cdr last)))
diff --git a/lisp/files.el b/lisp/files.el
index 042b8e2d515..cf59137892d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1184,8 +1184,9 @@ locate-user-emacs-file
        (or noninteractive
            dump-mode
 	   (let (errtype)
-	     (if (file-directory-p user-emacs-directory)
-		 (or (file-accessible-directory-p user-emacs-directory)
+	     (if (or (not user-emacs-directory) (file-directory-p user-emacs-directory))
+		 (or (and user-emacs-directory
+                          (file-accessible-directory-p user-emacs-directory))
 		     (setq errtype "access"))
                ;; We don't want to create HOME if it doesn't exist.
                (if (and (not (file-exists-p "~"))
diff --git a/src/alloc.c b/src/alloc.c
index 5ee1b37e292..12907e0c94b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5836,12 +5836,24 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes)
 }
 
 Lisp_Object *
-hash_table_alloc_kv (void *h, ptrdiff_t nobjs)
+hash_table_alloc_k (void *h, ptrdiff_t nobjs, hash_table_weakness_t weak)
 {
   if (nobjs == 0)
     return NULL;
 #ifdef HAVE_MPS
-  return igc_make_hash_table_vec (nobjs);
+  return igc_make_hash_table_vec (nobjs, weak == Weak_Key_And_Value || weak == Weak_Key);
+#else
+   return xmalloc (nobjs * sizeof (Lisp_Object));
+#endif
+}
+
+Lisp_Object *
+hash_table_alloc_v (void *h, ptrdiff_t nobjs, hash_table_weakness_t weak)
+{
+  if (nobjs == 0)
+    return NULL;
+#ifdef HAVE_MPS
+  return igc_make_hash_table_vec (nobjs, weak == Weak_Key_And_Value || weak == Weak_Value);
 #else
    return xmalloc (nobjs * sizeof (Lisp_Object));
 #endif
diff --git a/src/data.c b/src/data.c
index dcf869c1a0e..996f57e2123 100644
--- a/src/data.c
+++ b/src/data.c
@@ -251,6 +251,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
         case PVEC_BOOL_VECTOR: return Qbool_vector;
         case PVEC_FRAME: return Qframe;
         case PVEC_HASH_TABLE: return Qhash_table;
+        case PVEC_WEAK_HASH_TABLE: return Qhash_table;
         case PVEC_OBARRAY: return Qobarray;
         case PVEC_FONT:
           if (FONT_SPEC_P (object))
diff --git a/src/fns.c b/src/fns.c
index f7603626454..5733a1b3797 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4596,6 +4596,25 @@ set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   h->index[idx] = val;
 }
 
+static void
+set_weak_hash_next_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->next[idx].lisp_object = make_fixnum (val);
+}
+static void
+set_weak_hash_hash_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->hash[idx].lisp_object = make_fixnum (val);
+}
+static void
+set_weak_hash_index_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  h->strong->index[idx].lisp_object = make_fixnum (val);
+}
+
 /* If OBJ is a Lisp hash table, return a pointer to its struct
    Lisp_Hash_Table.  Otherwise, signal an error.  */
 
@@ -4606,6 +4625,14 @@ check_hash_table (Lisp_Object obj)
   return XHASH_TABLE (obj);
 }
 
+static struct Lisp_Weak_Hash_Table *
+check_maybe_weak_hash_table (Lisp_Object obj)
+{
+  if (WEAK_HASH_TABLE_P (obj))
+    return XWEAK_HASH_TABLE (obj);
+  return NULL;
+}
+
 
 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime
    number.  A number is "almost" a prime number if it is not divisible
@@ -4687,6 +4714,13 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->next[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_NEXT (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->next[idx].lisp_object);
+}
+
 /* Return the index of the element in hash table H that is the start
    of the collision list at index IDX, or -1 if the list is empty.  */
 
@@ -4697,6 +4731,13 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->index[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_INDEX (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  return XFIXNUM (h->strong->index[idx].lisp_object);
+}
+
 /* Restore a hash table's mutability after the critical section exits.  */
 
 static void
@@ -4821,6 +4862,22 @@ allocate_hash_table (void)
   return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
 }
 
+static struct Lisp_Weak_Hash_Table *
+allocate_weak_hash_table (hash_table_weakness_t weak, ssize_t size, ssize_t index_bits)
+{
+  struct Lisp_Weak_Hash_Table *ret =
+    ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+  ret->strong = igc_alloc_weak_hash_table_strong_part (weak, size, index_bits);
+  ret->strong->hash = ret->strong->entries + 0;
+  ret->strong->value = ret->strong->entries + 1 * size;
+  ret->strong->next = ret->strong->entries + 2 * size;
+  ret->strong->index = ret->strong->entries + 3 * size;
+  ret->weak = igc_alloc_weak_hash_table_weak_part (weak, size, index_bits);
+  ret->weak->strong = ret->strong;
+  ret->strong->key = ret->weak->entries;
+  return ret;
+}
+
 /* Compute the size of the index (as log2) from the table capacity.  */
 static int
 compute_hash_index_bits (hash_idx_t size)
@@ -4855,6 +4912,53 @@ compute_hash_index_bits (hash_idx_t size)
    `purecopy' when Emacs is being dumped. Such tables can no longer be
    changed after purecopy.  */
 
+Lisp_Object
+make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size,
+		      hash_table_weakness_t weak, bool purecopy)
+{
+  eassert (!purecopy);
+  eassert (SYMBOLP (test->name));
+  eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
+
+  if (size < 1024)
+    size = 1024;
+
+  struct Lisp_Weak_Hash_Table *h = allocate_weak_hash_table (weak, size, compute_hash_index_bits (size));
+
+  h->strong->test = test;
+  h->strong->weakness = weak;
+  h->strong->count = make_fixnum (0);
+  h->strong->table_size = make_fixnum (size);
+
+  if (size == 0)
+    {
+    }
+  else
+    {
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  h->strong->value[i].ptr = 0;
+	}
+
+      for (ptrdiff_t i = 0; i < size - 1; i++)
+	h->strong->next[i].lisp_object = make_fixnum(i + 1);
+      h->strong->next[size - 1].lisp_object = make_fixnum(-1);
+
+      int index_bits = compute_hash_index_bits (size);
+      h->strong->index_bits = make_fixnum (index_bits);
+      ptrdiff_t index_size = weak_hash_table_index_size (h);
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	h->strong->index[i].lisp_object = make_fixnum (-1);
+
+      h->strong->next_free = make_fixnum (0);
+    }
+
+  h->strong->purecopy = purecopy;
+  h->strong->mutable = true;
+  return make_lisp_weak_hash_table (h);
+}
+
 Lisp_Object
 make_hash_table (const struct hash_table_test *test, EMACS_INT size,
 		 hash_table_weakness_t weak, bool purecopy)
@@ -4862,6 +4966,10 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
   eassert (SYMBOLP (test->name));
   eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
 
+  if (weak != Weak_None)
+    {
+      return make_weak_hash_table (test, size, weak, purecopy);
+    }
   struct Lisp_Hash_Table *h = allocate_hash_table ();
 
   h->test = test;
@@ -4881,8 +4989,8 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
     }
   else
     {
-      Lisp_Object *key = hash_table_alloc_kv (h, size);
-      Lisp_Object *value = hash_table_alloc_kv (h, size);
+      Lisp_Object *key = hash_table_alloc_k (h, size, weak);
+      Lisp_Object *value = hash_table_alloc_v (h, size, weak);
       for (ptrdiff_t i = 0; i < size; i++)
 	{
 	  key[i] = HASH_UNUSED_ENTRY_KEY;
@@ -4932,8 +5040,8 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
   if (h1->table_size > 0)
     {
       ptrdiff_t kv_bytes = h1->table_size * sizeof *h1->key;
-      Lisp_Object *key = hash_table_alloc_kv (h2, h1->table_size);
-      Lisp_Object *value = hash_table_alloc_kv (h2, h1->table_size);
+      Lisp_Object *key = hash_table_alloc_k (h2, h1->table_size, h2->weakness);
+      Lisp_Object *value = hash_table_alloc_v (h2, h1->table_size, h2->weakness);
       memcpy (key, h1->key, kv_bytes);
       memcpy (value, h1->value, kv_bytes);
       h2->key = key;
@@ -4961,6 +5069,13 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
   return knuth_hash (hash, h->index_bits);
 }
 
+/* Compute index into the index vector from a hash value.  */
+static inline ptrdiff_t
+weak_hash_index_index (struct Lisp_Weak_Hash_Table *h, hash_hash_t hash)
+{
+  return knuth_hash (hash, XFIXNUM (h->strong->index_bits));
+}
+
 /* Resize hash table H if it's too full.  If H cannot be resized
    because it's already too large, throw an error.  */
 
@@ -4985,8 +5100,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
 	next[i] = i + 1;
       next[new_size - 1] = -1;
 
-      Lisp_Object *key = hash_table_alloc_kv (h, new_size);
-      Lisp_Object *value = hash_table_alloc_kv (h, new_size);
+      Lisp_Object *key = hash_table_alloc_k (h, new_size, h->weakness);
+      Lisp_Object *value = hash_table_alloc_v (h, new_size, h->weakness);
       memcpy (key, h->key, old_size * sizeof *key);
       memcpy (value, h->value, old_size * sizeof *value);
       for (ptrdiff_t i = old_size; i < new_size; i++)
@@ -5173,6 +5288,30 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h,
   return -1;
 }
 
+/* Look up KEY with hash HASH in table H.
+   Return entry index or -1 if none.  */
+static ptrdiff_t
+weak_hash_lookup_with_hash (struct Lisp_Weak_Hash_Table *h,
+			    Lisp_Object key, hash_hash_t hash)
+{
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i; i = WEAK_HASH_NEXT (h, i))
+    if (EQ (key, WEAK_HASH_KEY (h, i))
+	|| (h->strong->test->cmpfn
+	    && hash == WEAK_HASH_HASH (h, i)
+	    && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+      return i;
+
+  return -1;
+}
+
+ptrdiff_t
+weak_hash_lookup (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return weak_hash_lookup_with_hash (h, key, weak_hash_from_key (h, key));
+}
+
 /* Look up KEY in table H.  Return entry index or -1 if none.  */
 ptrdiff_t
 hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -5229,6 +5368,36 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
   return i;
 }
 
+/* Put an entry into hash table H that associates KEY with VALUE.
+   HASH is a previously computed hash code of KEY.
+   Value is the index of the entry in H matching KEY.  */
+
+ptrdiff_t
+weak_hash_put (struct Lisp_Weak_Hash_Table *h, Lisp_Object key, Lisp_Object value,
+	       hash_hash_t hash)
+{
+  //eassert (!hash_unused_entry_key_p (key));
+  /* Increment count after resizing because resizing may fail.  */
+  //maybe_resize_hash_table (h);
+  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) + 1);
+
+  /* Store key/value in the key_and_value vector.  */
+  ptrdiff_t i = XFIXNUM (h->strong->next_free);
+  //eassert (hash_unused_entry_key_p (HASH_KEY (h, i)));
+  h->strong->next_free = make_fixnum (WEAK_HASH_NEXT (h, i));
+  set_weak_hash_key_slot (h, i, key);
+  set_weak_hash_value_slot (h, i, value);
+
+  /* Remember its hash code.  */
+  set_weak_hash_hash_slot (h, i, hash);
+
+  /* Add new entry to its collision chain.  */
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  set_weak_hash_next_slot (h, i, WEAK_HASH_INDEX (h, start_of_bucket));
+  set_weak_hash_index_slot (h, start_of_bucket, i);
+  return i;
+}
+
 
 /* Remove the entry matching KEY from hash table H, if there is one.  */
 
@@ -5270,6 +5439,42 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
 }
 
 
+/* Remove the entry matching KEY from hash table H, if there is one.  */
+
+void
+weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0)
+{
+  hash_hash_t hashval = WEAK_HASH_HASH (h, i0);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (i == i0)
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	  set_weak_hash_next_slot (h, i, h->strong->next_free);
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
 /* Clear hash table H.  */
 
 static void
@@ -5920,6 +6125,11 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
        doc: /* Return the number of elements in TABLE.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      return wh->strong->count;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   return make_fixnum (h->count);
 }
@@ -6020,6 +6230,12 @@ DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
 If KEY is not found, return DFLT which defaults to nil.  */)
   (Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      ptrdiff_t i = weak_hash_lookup (wh, key);
+      return i >= 0 ? WEAK_HASH_VALUE (wh, i) : dflt;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   ptrdiff_t i = hash_lookup (h, key);
   return i >= 0 ? HASH_VALUE (h, i) : dflt;
@@ -6032,6 +6248,17 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
 VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      EMACS_UINT hash = weak_hash_from_key (wh, key);
+      ptrdiff_t i = weak_hash_lookup_with_hash (wh, key, hash);
+      if (i >= 0)
+	set_weak_hash_value_slot (wh, i, value);
+      else
+	weak_hash_put (wh, key, value, hash);
+      return value;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
 
diff --git a/src/igc.c b/src/igc.c
index 6920417c82e..9e8fd80e68b 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -362,6 +362,7 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_PTR_VEC",
   "IGC_OBJ_OBJ_VEC",
   "IGC_OBJ_HASH_VEC",
+  "IGC_OBJ_HASH_VEC_WEAK",
   "IGC_OBJ_HANDLER",
   "IGC_OBJ_BYTES",
   "IGC_OBJ_BUILTIN_SYMBOL",
@@ -372,6 +373,8 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_DUMPED_BUFFER_TEXT",
   "IGC_OBJ_DUMPED_BIGNUM_DATA",
   "IGC_OBJ_DUMPED_BYTES",
+  "IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART",
+  "IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART",
 };
 
 static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@@ -399,6 +402,7 @@ obj_type_name (enum igc_obj_type type)
   "PVEC_BOOL_VECTOR",
   "PVEC_BUFFER",
   "PVEC_HASH_TABLE",
+  "PVEC_WEAK_HASH_TABLE",
 #ifndef IN_MY_FORK
   "PVEC_OBARRAY",
 #endif
@@ -460,8 +464,8 @@ pvec_type_name (enum pvec_type type)
 
 enum
 {
-  IGC_TYPE_BITS = 5,
-  IGC_HASH_BITS = 27,
+  IGC_TYPE_BITS = 6,
+  IGC_HASH_BITS = 26,
   IGC_SIZE_BITS = 32,
   IGC_HASH_MASK = (1 << IGC_HASH_BITS) - 1,
 };
@@ -562,6 +566,32 @@ object_nelems (void *client, size_t elem_size)
   return obj_client_size (h) / elem_size;
 }
 
+Lisp_Object
+igc_ptr_to_lisp (void *client)
+{
+  if (client == 0)
+    return Qnil;
+  mps_addr_t base = client_to_base (client);
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_STRING:
+      return make_lisp_ptr (client, Lisp_String);
+
+    case IGC_OBJ_VECTOR:
+      return make_lisp_ptr (client, Lisp_Vectorlike);
+
+    case IGC_OBJ_CONS:
+      return make_lisp_ptr (client, Lisp_Cons);
+
+      return make_lisp_ptr (client, Lisp_Float);
+
+    default:
+      IGC_NOT_IMPLEMENTED ();
+      emacs_abort ();
+    }
+}
+
 /* Round NBYTES to the next multiple of ALIGN. */
 
 static size_t
@@ -638,6 +668,8 @@ IGC_DEFINE_LIST (igc_root);
   mps_ap_t leaf_ap;
   mps_ap_t weak_strong_ap;
   mps_ap_t weak_weak_ap;
+  mps_ap_t weak_hash_strong_ap;
+  mps_ap_t weak_hash_weak_ap;
   mps_ap_t immovable_ap;
 
   /* Quick access to the roots used for specpdl, bytecode stack and
@@ -674,6 +706,8 @@ IGC_DEFINE_LIST (igc_thread);
   mps_pool_t leaf_pool;
   mps_fmt_t weak_fmt;
   mps_pool_t weak_pool;
+  mps_fmt_t weak_hash_fmt;
+  mps_pool_t weak_hash_pool;
   mps_fmt_t immovable_fmt;
   mps_pool_t immovable_pool;
 
@@ -1521,6 +1555,8 @@ fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes)
 }
 
 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
+static fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t);
+static fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w);
 
 static mps_res_t
 dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
@@ -1641,6 +1677,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client,
 					     obj_size (header)));
 	break;
+
+      case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client,
+			 fix_weak_hash_table_strong_part);
+	break;
+      case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client,
+			 fix_weak_hash_table_weak_part);
+	break;
       }
   }
   MPS_SCAN_END (ss);
@@ -1816,6 +1861,64 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    // FIXME/igc: weak hash tables
+    IGC_FIX12_RAW (ss, &h->strong);
+    IGC_FIX12_RAW (ss, &h->weak);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	IGC_FIX12_OBJ (ss, &t->entries[i]);
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+extern void
+weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0);
+
+static mps_res_t
+fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &w->strong);
+    struct Lisp_Weak_Hash_Table_Strong_Part *t = w->strong;
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	bool was_nil = NILP (w->entries[i].lisp_object);
+	IGC_FIX12_OBJ (ss, &w->entries[i]);
+	bool is_now_nil = NILP (w->entries[i].lisp_object);
+
+	if (is_now_nil && !was_nil)
+	  {
+	    struct Lisp_Weak_Hash_Table pseudo_h =
+	      {
+		.strong = t,
+		.weak = w,
+	      };
+	    weak_hash_splat_from_table (&pseudo_h, i);
+	  }
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t
 fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
 {
@@ -2108,6 +2211,10 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
 	IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
 	break;
 
+      case PVEC_WEAK_HASH_TABLE:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_weak_hash_table);
+	break;
+
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
 	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table);
@@ -2480,6 +2587,22 @@ create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
   return res;
 }
 
+static mps_res_t
+create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
+{
+  struct igc *gc = t->gc;
+  mps_res_t res;
+  mps_pool_t pool = gc->weak_hash_pool;
+  MPS_ARGS_BEGIN (args)
+  {
+    MPS_ARGS_ADD (args, MPS_KEY_RANK,
+		  weak ? mps_rank_weak () : mps_rank_exact ());
+    res = mps_ap_create_k (ap, pool, args);
+  }
+  MPS_ARGS_END (args);
+  return res;
+}
+
 static void
 create_thread_aps (struct igc_thread *t)
 {
@@ -2495,6 +2618,10 @@ create_thread_aps (struct igc_thread *t)
   IGC_CHECK_RES (res);
   res = create_weak_ap (&t->weak_weak_ap, t, true);
   IGC_CHECK_RES (res);
+  res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
+  IGC_CHECK_RES (res);
+  res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true);
+  IGC_CHECK_RES (res);
 }
 
 static struct igc_thread_list *
@@ -2553,6 +2680,8 @@ igc_thread_remove (void **pinfo)
   mps_ap_destroy (t->d.leaf_ap);
   mps_ap_destroy (t->d.weak_strong_ap);
   mps_ap_destroy (t->d.weak_weak_ap);
+  mps_ap_destroy (t->d.weak_hash_strong_ap);
+  mps_ap_destroy (t->d.weak_hash_weak_ap);
   mps_ap_destroy (t->d.immovable_ap);
   mps_thread_dereg (deregister_thread (t));
 }
@@ -3216,6 +3345,12 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_VECTOR_WEAK:
       return t->d.weak_weak_ap;
 
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      return t->d.weak_hash_weak_ap;
+
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      return t->d.weak_hash_strong_ap;
+
     case IGC_OBJ_VECTOR:
     case IGC_OBJ_CONS:
     case IGC_OBJ_SYMBOL:
@@ -3581,11 +3716,27 @@ igc_alloc_lisp_obj_vec (size_t n)
 }
 
 Lisp_Object *
-igc_make_hash_table_vec (size_t n)
+igc_make_hash_table_vec (size_t n, bool weak)
 {
+  if (weak)
+    return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC_WEAK);
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC);
 }
 
+struct Lisp_Weak_Hash_Table_Strong_Part *
+igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART);
+}
+
+struct Lisp_Weak_Hash_Table_Weak_Part *
+igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART);
+}
+
 /* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only
    be used for growing a vector of pointers whose current size is N
    pointers.  */
@@ -3939,6 +4090,8 @@ make_igc (void)
   gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt);
   gc->weak_fmt = make_dflt_fmt (gc);
   gc->weak_pool = make_pool_awl (gc, gc->weak_fmt);
+  gc->weak_hash_fmt = make_dflt_fmt (gc);
+  gc->weak_hash_pool = make_pool_awl (gc, gc->weak_hash_fmt);
   gc->immovable_fmt = make_dflt_fmt (gc);
   gc->immovable_pool = make_pool_ams (gc, gc->immovable_fmt);
 
diff --git a/src/igc.h b/src/igc.h
index 95a0d25cbba..08524c51e06 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -46,6 +46,7 @@ #define EMACS_IGC_H
   IGC_OBJ_PTR_VEC,
   IGC_OBJ_OBJ_VEC,
   IGC_OBJ_HASH_VEC,
+  IGC_OBJ_HASH_VEC_WEAK,
   IGC_OBJ_HANDLER,
   IGC_OBJ_BYTES,
   IGC_OBJ_BUILTIN_SYMBOL,
@@ -56,6 +57,8 @@ #define EMACS_IGC_H
   IGC_OBJ_DUMPED_BUFFER_TEXT,
   IGC_OBJ_DUMPED_BIGNUM_DATA,
   IGC_OBJ_DUMPED_BYTES,
+  IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART,
+  IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART,
   IGC_OBJ_NUM_TYPES
 };
 
@@ -121,7 +124,9 @@ #define EMACS_IGC_H
 void *igc_make_ptr_vec (size_t n);
 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_make_hash_table_vec (size_t n, bool weak);
+struct Lisp_Weak_Hash_Table_Strong_Part *igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, size_t, size_t);
+struct Lisp_Weak_Hash_Table_Weak_Part *igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, size_t, size_t);
 void *igc_alloc_bytes (size_t nbytes);
 struct image_cache *igc_make_image_cache (void);
 struct interval *igc_make_interval (void);
diff --git a/src/lisp.h b/src/lisp.h
index db3a7fd1507..990c5784145 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1039,6 +1039,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
   PVEC_BOOL_VECTOR,
   PVEC_BUFFER,
   PVEC_HASH_TABLE,
+  PVEC_WEAK_HASH_TABLE,
   PVEC_OBARRAY,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
@@ -2558,6 +2559,7 @@ #define DOOBARRAY(oa, it)					\
 
 /* The structure of a Lisp hash table.  */
 
+struct Lisp_Weak_Hash_Table;
 struct Lisp_Hash_Table;
 struct hash_impl;
 
@@ -2605,6 +2607,58 @@ #define DOOBARRAY(oa, it)					\
    (hash) indices.  It's signed and a subtype of ptrdiff_t.  */
 typedef int32_t hash_idx_t;
 
+union Lisp_Weak_Hash_Table_Entry
+{
+  struct
+  {
+    uint32_t u32 : 32;
+    int tag : 3;
+  } s;
+  void *ptr;
+  Lisp_Object lisp_object; /* must be a fixnum! */
+};
+
+struct Lisp_Weak_Hash_Table_Strong_Part
+{
+  Lisp_Object index_bits;
+  Lisp_Object count;
+  Lisp_Object next_free;
+  Lisp_Object table_size;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  const struct hash_table_test *test;
+  union Lisp_Weak_Hash_Table_Entry *index; /* internal pointer */
+  union Lisp_Weak_Hash_Table_Entry *hash; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *next; /* internal pointer */
+  hash_table_weakness_t weakness : 3;
+  hash_table_std_test_t frozen_test : 2;
+
+  /* True if the table can be purecopied.  The table cannot be
+     changed afterwards.  */
+  bool_bf purecopy : 1;
+
+  /* True if the table is mutable.  Ordinarily tables are mutable, but
+     pure tables are not, and while a table is being mutated it is
+     immutable for recursive attempts to mutate it.  */
+  bool_bf mutable : 1;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table_Weak_Part
+{
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table
+{
+  union vectorlike_header header;
+
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+};
+
 struct Lisp_Hash_Table
 {
   union vectorlike_header header;
@@ -2725,6 +2779,23 @@ XHASH_TABLE (Lisp_Object a)
   return h;
 }
 
+INLINE bool
+WEAK_HASH_TABLE_P (Lisp_Object a)
+{
+  return PSEUDOVECTORP (a, PVEC_WEAK_HASH_TABLE);
+}
+
+INLINE struct Lisp_Weak_Hash_Table *
+XWEAK_HASH_TABLE (Lisp_Object a)
+{
+  eassert (WEAK_HASH_TABLE_P (a));
+  struct Lisp_Weak_Hash_Table *h
+    = XUNTAG (a, Lisp_Vectorlike, struct Lisp_Weak_Hash_Table);
+  igc_check_fwd (h);
+  return h;
+}
+
+extern Lisp_Object igc_ptr_to_lisp (void *ptr);
 INLINE Lisp_Object
 make_lisp_hash_table (struct Lisp_Hash_Table *h)
 {
@@ -2732,6 +2803,13 @@ make_lisp_hash_table (struct Lisp_Hash_Table *h)
   return make_lisp_ptr (h, Lisp_Vectorlike);
 }
 
+INLINE Lisp_Object
+make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_WEAK_HASH_TABLE));
+  return make_lisp_ptr (h, Lisp_Vectorlike);
+}
+
 /* Value is the key part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2740,6 +2818,14 @@ HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->key[idx];
 }
 
+/* Value is the key part of entry IDX in hash table H.  */
+INLINE Lisp_Object
+WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return h->strong->key[idx].lisp_object;
+}
+
 /* Value is the value part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2748,6 +2834,12 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->value[idx];
 }
 
+INLINE Lisp_Object
+WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  return h->strong->value[idx].lisp_object;
+}
+
 /* Value is the hash code computed for entry IDX in hash table H.  */
 INLINE hash_hash_t
 HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2756,6 +2848,14 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->hash[idx];
 }
 
+/* Value is the hash code computed for entry IDX in hash table H.  */
+INLINE hash_hash_t
+WEAK_HASH_HASH (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->hash[idx].lisp_object);
+}
+
 /* Value is the size of hash table H.  */
 INLINE ptrdiff_t
 HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
@@ -2770,6 +2870,12 @@ hash_table_index_size (const struct Lisp_Hash_Table *h)
   return (ptrdiff_t)1 << h->index_bits;
 }
 
+INLINE ptrdiff_t
+weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h)
+{
+  return (ptrdiff_t)1 << XFIXNUM (h->strong->index_bits);
+}
+
 /* Hash value for KEY in hash table H.  */
 INLINE hash_hash_t
 hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -2777,6 +2883,13 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
   return h->test->hashfn (key, h);
 }
 
+/* Hash value for KEY in hash table H.  */
+INLINE hash_hash_t
+weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return h->strong->test->hashfn (key, NULL);
+}
+
 /* Iterate K and V as key and value of valid entries in hash table H.
    The body may remove the current entry or alter its value slot, but not
    mutate TABLE in any other way.  */
@@ -4086,6 +4199,13 @@ set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->key[idx] = val;
 }
 
+INLINE void
+set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->key[idx].lisp_object = val;
+}
+
 INLINE void
 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
@@ -4093,6 +4213,13 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->value[idx] = val;;
 }
 
+INLINE void
+set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size) );
+  h->strong->value[idx].lisp_object = val;
+}
+
 /* Use these functions to set Lisp_Object
    or pointer slots of struct Lisp_Symbol.  */
 
@@ -4360,6 +4487,8 @@ #define CONS_TO_INTEGER(cons, type, var)				\
 				hash_hash_t *phash);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
 		    hash_hash_t);
+ptrdiff_t weak_hash_put (struct Lisp_Weak_Hash_Table *, Lisp_Object, Lisp_Object,
+			 hash_hash_t);
 void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
 extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
 extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
@@ -4783,7 +4912,8 @@ #define ALLOCATE_ZEROED_PSEUDOVECTOR(type, field, tag)		       \
 
 void *hash_table_alloc_bytes (ptrdiff_t nbytes) ATTRIBUTE_MALLOC_SIZE ((1));
 void hash_table_free_bytes (void *p, ptrdiff_t nbytes);
-Lisp_Object *hash_table_alloc_kv (void *h, ptrdiff_t nobjs);
+Lisp_Object *hash_table_alloc_k (void *h, ptrdiff_t nobjs, hash_table_weakness_t weak);
+Lisp_Object *hash_table_alloc_v (void *h, ptrdiff_t nobjs, hash_table_weakness_t weak);
 void hash_table_free_kv (void *h, Lisp_Object *p);
 
 /* Defined in gmalloc.c.  */
diff --git a/src/lread.c b/src/lread.c
index 188922516ea..4da0f295884 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -5241,7 +5241,7 @@ make_obarray (unsigned bits)
   o->size_bits = bits;
   ptrdiff_t size = (ptrdiff_t)1 << bits;
 #ifdef HAVE_MPS
-  o->buckets = hash_table_alloc_kv (o, size);
+  o->buckets = hash_table_alloc_v (o, size, Weak_None);
 #else
   o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets);
 #endif
@@ -5269,7 +5269,7 @@ grow_obarray (struct Lisp_Obarray *o)
     error ("Obarray too big");
   ptrdiff_t new_size = (ptrdiff_t) 1 << new_bits;
 #ifdef HAVE_MPS
-  o->buckets = hash_table_alloc_kv (o, new_size);
+  o->buckets = hash_table_alloc_v (o, new_size, Weak_None);
 #else
   o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets);
 #endif
@@ -5343,7 +5343,7 @@ DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0,
   int new_bits = obarray_default_bits;
   int new_size = (ptrdiff_t)1 << new_bits;
 #ifdef HAVE_MPS
-  Lisp_Object *new_buckets = hash_table_alloc_kv (o, new_size);
+  Lisp_Object *new_buckets = hash_table_alloc_v (o, new_size, Weak_None);
 #else
   Lisp_Object *new_buckets
     = hash_table_alloc_bytes (new_size * sizeof *new_buckets);
diff --git a/src/pdumper.c b/src/pdumper.c
index 06fd665e27f..50a17e9f3f5 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2661,8 +2661,8 @@ hash_table_contents (struct Lisp_Hash_Table *h, Lisp_Object **key,
 		     Lisp_Object **value)
 {
   ptrdiff_t size = h->count;
-  *key = hash_table_alloc_kv (h, size);
-  *value = hash_table_alloc_kv (h, size);
+  *key = hash_table_alloc_k (h, size, h->weakness);
+  *value = hash_table_alloc_v (h, size, h->weakness);
   ptrdiff_t n = 0;
 
   DOHASH (h, k, v)
diff --git a/src/print.c b/src/print.c
index 2840252246f..f7b74f985a0 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2188,6 +2188,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_BIGNUM:
     case PVEC_BOOL_VECTOR:
     /* Impossible cases.  */
@@ -2786,6 +2787,53 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    goto next_obj;
 	  }
 
+	case PVEC_WEAK_HASH_TABLE:
+	  {
+	    struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj);
+	    /* Implement a readable output, e.g.:
+	       #s(hash-table test equal data (k1 v1 k2 v2)) */
+	    print_c_string ("#s(hash-table", printcharfun);
+
+	    if (!BASE_EQ (h->strong->test->name, Qeql))
+	      {
+		print_c_string (" test ", printcharfun);
+		print_object (h->strong->test->name, printcharfun, escapeflag);
+	      }
+
+	    if (h->strong->weakness != Weak_None)
+	      {
+		print_c_string (" weakness ", printcharfun);
+		print_object (hash_table_weakness_symbol (h->strong->weakness),
+			      printcharfun, escapeflag);
+	      }
+
+	    ptrdiff_t size = XFIXNUM (h->strong->count);
+	    if (size > 0)
+	      {
+		print_c_string (" data (", printcharfun);
+
+		/* Don't print more elements than the specified maximum.  */
+		if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
+		  size = XFIXNAT (Vprint_length);
+
+		print_stack_push ((struct print_stack_entry){
+		    .type = PE_hash,
+		    .u.hash.obj = obj,
+		    .u.hash.nobjs = size * 2,
+		    .u.hash.idx = 0,
+		    .u.hash.printed = 0,
+		    .u.hash.truncated = (size < XFIXNUM (h->strong->count)),
+		  });
+	      }
+	    else
+	      {
+		/* Empty table: we can omit the data entirely.  */
+		printchar (')', printcharfun);
+		--print_depth;   /* Done with this.  */
+	      }
+	    goto next_obj;
+	  }
+
 	case PVEC_BIGNUM:
 	  print_bignum (obj, printcharfun);
 	  break;
diff --git a/src/textconv.c b/src/textconv.c
index 0e43bd9d458..d4cc4cebb11 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -478,7 +478,7 @@ record_buffer_change (ptrdiff_t beg, ptrdiff_t end,
 
   /* Make markers for both BEG and END.  */
   beg_marker = build_marker (current_buffer, beg,
-			     CHAR_TO_BYTE (beg));
+			     CHAR_TO_BYTE (beg), 0);
 
   /* If BEG and END are identical, make sure to keep the markers
      eq.  */
@@ -488,7 +488,7 @@ record_buffer_change (ptrdiff_t beg, ptrdiff_t end,
   else
     {
       end_marker = build_marker (current_buffer, end,
-				 CHAR_TO_BYTE (end));
+				 CHAR_TO_BYTE (end), 0);
 
       /* Otherwise, make sure the marker extends past inserted
 	 text.  */
@@ -868,9 +868,9 @@ really_set_composing_text (struct frame *f, ptrdiff_t position,
 
       /* Now set the markers which denote the composition region.  */
       f->conversion.compose_region_start
-	= build_marker (current_buffer, PT, PT_BYTE);
+	= build_marker (current_buffer, PT, PT_BYTE, 0);
       f->conversion.compose_region_end
-	= build_marker (current_buffer, PT, PT_BYTE);
+	= build_marker (current_buffer, PT, PT_BYTE, 0);
 
       Fset_marker_insertion_type (f->conversion.compose_region_end,
 				  Qt);
@@ -1165,8 +1165,8 @@ locate_and_save_position_in_field (struct frame *f, struct window *w,
     }
   else
     {
-      c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg));
-      c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end));
+      c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg), 0);
+      c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end), 0);
       Fset_marker_insertion_type (c2, Qt);
       f->conversion.field = Fcons (c1, Fcons (c2, window));
     }

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

>> True. I forgot to mention an important thing: When something is splat,
>> set flag(s) in the dependent hash table indicating that something must
>> be done because of that splatting. In gethash and so, check the flag and
>> do what's necessary. (I did something similar for the weak hash tables
>> in CMUCL, and it wasn't entirely bad. And weak tables should be rare.)
>
> Not necessarily rare, particularly not if we turn BUF_MARKERS into a
> weak hash table (I still don't see why we shouldn't do that, maybe I
> missed it).

Hm, don't know. On the one hand, there's Stefan's gap buffer data
structure, and on the other hand add_marker and remove_marker are now
O(1) in igc, modulo bugs. So the pressure has decreased.

>
> But, yes, that's a good idea and requires far fewer changes to the
> hash table code than I've now made locally. However, I've decided to
> go through with it and have just successfully splatted my first weak
> hash table entry.

Congrats! :-). I have to say, my ideas are idle musings, that I'll
probably never realize. Working code wins :-).

> If we go with my original proposal (which I'm not at all sure about at
> this point as the code is really ugly), we'd have to have something
> like:
>
> struct Lisp_Weak_Hash_Table
> {
>   union vectorlike_header header;
>
>   struct Lisp_Weak_Hash_Table_Strong_Part *strong;
>   struct Lisp_Weak_Hash_Table_Weak_Part *weak;
> };

Thanks, I think I got it now. I lost context.

Re: MPS: dangling markers

[Pip Cet]

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

On Sunday, June 30th, 2024 at 13:15, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Pip Cet pipcet@protonmail.com writes:
> 
> > > True. I forgot to mention an important thing: When something is splat,
> > > set flag(s) in the dependent hash table indicating that something must
> > > be done because of that splatting. In gethash and so, check the flag and
> > > do what's necessary. (I did something similar for the weak hash tables
> > > in CMUCL, and it wasn't entirely bad. And weak tables should be rare.)
> > 
> > Not necessarily rare, particularly not if we turn BUF_MARKERS into a
> > weak hash table (I still don't see why we shouldn't do that, maybe I
> > missed it).
> 
> 
> Hm, don't know. On the one hand, there's Stefan's gap buffer data
> structure, and on the other hand add_marker and remove_marker are now
> O(1) in igc, modulo bugs. So the pressure has decreased.

Well, I needed a weak hash table to test things on, which is why I've included the change in the attached patch.

> > But, yes, that's a good idea and requires far fewer changes to the
> > hash table code than I've now made locally. However, I've decided to
> > go through with it and have just successfully splatted my first weak
> > hash table entry.
> 
> Congrats! :-). I have to say, my ideas are idle musings, that I'll
> probably never realize. Working code wins :-).

I've implemented weak-key hash tables for the scratch/igc branch. Like
existing hash tables, the tables themselves never shrink automatically,
but can grow; entries can be removed by GC as well as manually, and the
table's apparent size will change immediately.

Unfortunately, much of the hash table code had to be duplicated: weak
hash tables are now composed of two objects which, in MPS language, are
"dependent objects" of each other: this means that when an entry in a
weak hash table is being removed during GC, we must not modify anything
except non-MPS memory and at most one object in addition to the one being
scanned.

It's possible to make strong hash tables a (boring) special case of weak
hash tables, but that seems backwards to me: strong hash tables need to
be fast, and they're the normal case, so extra indirection to make them
behave more like the limited weak hash table case is worse than
duplicating some code.

There's a lot of boring TODO work:
 * make them readable in lread.c
 * restore them properly from the dump rather than, as the current code does, making and keeping them strong
 * user-defined hash functions
 * weak-value hash tables
 * stop wasting quite as much memory by overallocating everything

Some intermediately-interesting TODO work:
 * key-and-value hash table weakness

And one very challenging item:
 * key-or-value hash table weakness

My understanding of the latter is that a reference to, say, the value
would need to keep the entire key/value pair alive. I'm not sure how to
do that with MPS, and I'm afraid the best course of action may be to
deprecate this rare feature.

(Of course, one possible implementation is to add another word to the
IGC header to keep alive a list of value-or-keys associated with this
key-or-value, but that seems disproportionately expensive).

There is a special optimization that MPS performs on 32-bit x86 systems which
requires all words of objects in our weak pool to be either misaligned
or valid pointers to (in our case) a struct igc_header. There's some
initial work toward supporting that, but the patch will probably not
work on 32-bit x86.

More TODO:
 * iterating over a weak hash table may be interrupted by GC. What happens then?
 * restore the weak vector code for Lisp_Marker, as Gerd indicated he prefers that to using a weak hash table. I removed it so we'd actually be working with weak hash tables.

Anyway, just thought sharing a snapshot of the current code might make discussing things easier.

Patch is against b278c7ede95816ba972f64647b68d05d88cc9f18.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-mps-weak-hash-tables.patch --]
[-- Type: text/x-patch; name=0002-mps-weak-hash-tables.patch, Size: 56251 bytes --]

diff --git a/src/alloc.c b/src/alloc.c
index 09b51ba2a08..5d47d3f7851 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6230,6 +6230,16 @@ purecopy (Lisp_Object obj)
 
       obj = make_lisp_hash_table (purecopy_hash_table (table));
     }
+  else if (WEAK_HASH_TABLE_P (obj))
+    {
+      /* Instead, add the hash table to the list of pinned objects,
+	 so that it will be marked during GC.  */
+      struct pinned_object *o = xmalloc (sizeof *o);
+      o->object = obj;
+      o->next = pinned_objects;
+      pinned_objects = o;
+      return obj; /* Don't hash cons it.  */
+    }
   else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
diff --git a/src/buffer.c b/src/buffer.c
index 09423e8592a..5a6075c1831 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -663,7 +663,7 @@ DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0,
 
   bset_mark (b, Fmake_marker ());
 #ifdef HAVE_MPS
-  BUF_MARKERS (b) = Qnil;
+  BUF_MARKERS (b) = make_hash_table (&hashtest_eq, 65, Weak_Key, false);
 #else
   BUF_MARKERS (b) = NULL;
 #endif
diff --git a/src/buffer.h b/src/buffer.h
index 7c1f743db9d..52969ba2fdd 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -795,13 +795,14 @@ marker_it_marker (struct marker_it *it)
 
 # endif
 
-# define DO_MARKERS(b, m)                                                 \
-  for (struct marker_it it_ = marker_it_init (b); marker_it_valid (&it_); \
-       marker_it_next (&it_))                                             \
-    {									\
-       struct Lisp_Marker *m = marker_it_marker (&it_);
+# define DO_MARKERS(b, m)						\
+  {									\
+    Lisp_Object k, v;							\
+    DOHASH_WEAK (XWEAK_HASH_TABLE (BUF_MARKERS (b)), k, v)			\
+      {									\
+	struct Lisp_Marker *m = XUNTAG (k, Lisp_Vectorlike, struct Lisp_Marker); \
 
-# define END_DO_MARKERS }
+# define END_DO_MARKERS } }
 
 struct sortvec
 {
diff --git a/src/data.c b/src/data.c
index dcf869c1a0e..996f57e2123 100644
--- a/src/data.c
+++ b/src/data.c
@@ -251,6 +251,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
         case PVEC_BOOL_VECTOR: return Qbool_vector;
         case PVEC_FRAME: return Qframe;
         case PVEC_HASH_TABLE: return Qhash_table;
+        case PVEC_WEAK_HASH_TABLE: return Qhash_table;
         case PVEC_OBARRAY: return Qobarray;
         case PVEC_FONT:
           if (FONT_SPEC_P (object))
diff --git a/src/fns.c b/src/fns.c
index f7603626454..3049ae37d65 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4583,12 +4583,28 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   eassert (idx >= 0 && idx < h->table_size);
   h->next[idx] = val;
 }
+
+static void
+set_weak_hash_next_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->next[idx].lisp_object = make_fixnum (val);
+}
+
 static void
 set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
 {
   eassert (idx >= 0 && idx < h->table_size);
   h->hash[idx] = val;
 }
+
+static void
+set_weak_hash_hash_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->hash[idx].lisp_object = make_fixnum (val);
+}
+
 static void
 set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
 {
@@ -4596,6 +4612,13 @@ set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   h->index[idx] = val;
 }
 
+static void
+set_weak_hash_index_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  h->strong->index[idx].lisp_object = make_fixnum (val);
+}
+
 /* If OBJ is a Lisp hash table, return a pointer to its struct
    Lisp_Hash_Table.  Otherwise, signal an error.  */
 
@@ -4606,6 +4629,14 @@ check_hash_table (Lisp_Object obj)
   return XHASH_TABLE (obj);
 }
 
+static struct Lisp_Weak_Hash_Table *
+check_maybe_weak_hash_table (Lisp_Object obj)
+{
+  if (WEAK_HASH_TABLE_P (obj))
+    return XWEAK_HASH_TABLE (obj);
+  return NULL;
+}
+
 
 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime
    number.  A number is "almost" a prime number if it is not divisible
@@ -4687,6 +4718,13 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->next[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_NEXT (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->next[idx].lisp_object);
+}
+
 /* Return the index of the element in hash table H that is the start
    of the collision list at index IDX, or -1 if the list is empty.  */
 
@@ -4697,6 +4735,13 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->index[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_INDEX (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  return XFIXNUM (h->strong->index[idx].lisp_object);
+}
+
 /* Restore a hash table's mutability after the critical section exits.  */
 
 static void
@@ -4821,6 +4866,48 @@ allocate_hash_table (void)
   return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
 }
 
+static struct Lisp_Weak_Hash_Table *
+allocate_weak_hash_table (hash_table_weakness_t weak, ssize_t size, ssize_t index_bits)
+{
+  struct Lisp_Weak_Hash_Table *ret =
+    ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+  ret->strong = igc_alloc_weak_hash_table_strong_part (weak, size, index_bits);
+  ret->strong->hash = ret->strong->entries + 0;
+  ret->strong->value = ret->strong->entries + 1 * size;
+  ret->strong->next = ret->strong->entries + 2 * size;
+  ret->strong->index = ret->strong->entries + 3 * size;
+  ret->weak = igc_alloc_weak_hash_table_weak_part (weak, size, index_bits);
+  ret->strong->weak = ret->weak;
+  ret->weak->strong = ret->strong;
+  ret->strong->key = ret->weak->entries;
+  return ret;
+}
+
+Lisp_Object
+strengthen_hash_table (Lisp_Object weak)
+{
+  Lisp_Object ret = make_hash_table (XWEAK_HASH_TABLE (weak)->strong->test, 0, Weak_None, 0);
+
+  Lisp_Object k, v;
+  DOHASH_WEAK (XWEAK_HASH_TABLE (weak), k, v)
+    {
+      Fputhash (k, v, ret);
+    }
+
+  return ret;
+}
+
+Lisp_Object
+strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *weak)
+{
+  if (!NILP (weak->dump_replacement))
+    return weak->dump_replacement;
+  Lisp_Object ret = strengthen_hash_table (make_lisp_weak_hash_table (weak));
+  weak->dump_replacement = ret;
+
+  return ret;
+}
+
 /* Compute the size of the index (as log2) from the table capacity.  */
 static int
 compute_hash_index_bits (hash_idx_t size)
@@ -4855,6 +4942,54 @@ compute_hash_index_bits (hash_idx_t size)
    `purecopy' when Emacs is being dumped. Such tables can no longer be
    changed after purecopy.  */
 
+Lisp_Object
+make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size,
+		      hash_table_weakness_t weak, bool purecopy)
+{
+  eassert (!purecopy);
+  eassert (SYMBOLP (test->name));
+  eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
+
+  if (size < 65)
+    size = 65;
+
+  struct Lisp_Weak_Hash_Table *h = allocate_weak_hash_table (weak, size, compute_hash_index_bits (size));
+
+  h->strong->test = test;
+  h->strong->weakness = weak;
+  h->strong->count = make_fixnum (0);
+  h->strong->table_size = make_fixnum (size);
+
+  if (size == 0)
+    {
+      emacs_abort ();
+    }
+  else
+    {
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  h->strong->value[i].ptr = 0;
+	}
+
+      for (ptrdiff_t i = 0; i < size - 1; i++)
+	h->strong->next[i].lisp_object = make_fixnum(i + 1);
+      h->strong->next[size - 1].lisp_object = make_fixnum(-1);
+
+      int index_bits = compute_hash_index_bits (size);
+      h->strong->index_bits = make_fixnum (index_bits);
+      ptrdiff_t index_size = weak_hash_table_index_size (h);
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	h->strong->index[i].lisp_object = make_fixnum (-1);
+
+      h->strong->next_free = make_fixnum (0);
+    }
+
+  h->strong->purecopy = purecopy;
+  h->strong->mutable = true;
+  return make_lisp_weak_hash_table (h);
+}
+
 Lisp_Object
 make_hash_table (const struct hash_table_test *test, EMACS_INT size,
 		 hash_table_weakness_t weak, bool purecopy)
@@ -4862,6 +4997,10 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
   eassert (SYMBOLP (test->name));
   eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
 
+  if (weak != Weak_None)
+    {
+      return make_weak_hash_table (test, size, weak, purecopy);
+    }
   struct Lisp_Hash_Table *h = allocate_hash_table ();
 
   h->test = test;
@@ -4961,6 +5100,13 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
   return knuth_hash (hash, h->index_bits);
 }
 
+/* Compute index into the index vector from a hash value.  */
+static inline ptrdiff_t
+weak_hash_index_index (struct Lisp_Weak_Hash_Table *h, hash_hash_t hash)
+{
+  return knuth_hash (hash, XFIXNUM (h->strong->index_bits));
+}
+
 /* Resize hash table H if it's too full.  If H cannot be resized
    because it's already too large, throw an error.  */
 
@@ -5042,6 +5188,71 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
     }
 }
 
+static void
+maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  if (XFIXNUM (h->strong->next_free) < 0)
+    {
+      ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
+      ptrdiff_t min_size = 6;
+      ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
+      /* Grow aggressively at small sizes, then just double.  */
+      ptrdiff_t new_size =
+	old_size == 0
+	? min_size
+	: (base_size <= 64 ? base_size * 4 : base_size * 2);
+
+      ptrdiff_t index_bits = compute_hash_index_bits (new_size);
+
+      struct Lisp_Weak_Hash_Table_Strong_Part *strong =
+	igc_alloc_weak_hash_table_strong_part (h->strong->weakness, new_size, index_bits);
+      struct Lisp_Weak_Hash_Table_Weak_Part *weak =
+	igc_alloc_weak_hash_table_weak_part (h->strong->weakness, new_size, index_bits);
+
+      memcpy (strong, h->strong, sizeof *strong);
+
+      strong->hash = strong->entries + 0;
+      strong->value = strong->entries + 1 * new_size;
+      strong->next = strong->entries + 2 * new_size;
+      strong->index = strong->entries + 3 * new_size;
+      strong->key = weak->entries;
+      strong->count = make_fixnum (0);
+      weak->strong = strong;
+      strong->weak = weak;
+
+      for (ptrdiff_t i = 0; i < new_size - 1; i++)
+	strong->next[i].lisp_object = make_fixnum (i + 1);
+      strong->next[new_size - 1].lisp_object = make_fixnum (-1);
+
+      for (ptrdiff_t i = 0; i < new_size; i++)
+	{
+	  strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  strong->value[i].lisp_object = Qnil;
+	}
+
+      ptrdiff_t index_size = (ptrdiff_t)1 << index_bits;
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	strong->index[i].lisp_object = make_fixnum (-1);
+
+      strong->index_bits = make_fixnum (index_bits);
+      strong->table_size = make_fixnum (new_size);
+      strong->next_free = make_fixnum (0);
+
+      struct Lisp_Weak_Hash_Table *pseudo =
+	ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+      pseudo->strong = strong;
+      pseudo->weak = weak;
+      Lisp_Object k, v;
+      DOHASH_WEAK (h, k, v)
+	{
+	  Fputhash (k, v, make_lisp_weak_hash_table (pseudo));
+	}
+
+      h->strong = strong;
+      h->weak = weak;
+    }
+}
+
 static const struct hash_table_test *
 hash_table_test_from_std (hash_table_std_test_t test)
 {
@@ -5058,6 +5269,7 @@ hash_table_test_from_std (hash_table_std_test_t test)
 void
 hash_table_thaw (Lisp_Object hash_table)
 {
+  eassert (HASH_TABLE_P (hash_table));
   struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table);
 
   /* Freezing discarded most non-essential information; recompute it.
@@ -5173,6 +5385,24 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h,
   return -1;
 }
 
+/* Look up KEY with hash HASH in weak hash table H.
+   Return entry index or -1 if none.  */
+static ptrdiff_t
+weak_hash_lookup_with_hash (struct Lisp_Weak_Hash_Table *h,
+			    Lisp_Object key, hash_hash_t hash)
+{
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i; i = WEAK_HASH_NEXT (h, i))
+    if (EQ (key, WEAK_HASH_KEY (h, i))
+	|| (h->strong->test->cmpfn
+	    && hash == WEAK_HASH_HASH (h, i)
+	    && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+      return i;
+
+  return -1;
+}
+
 /* Look up KEY in table H.  Return entry index or -1 if none.  */
 ptrdiff_t
 hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -5180,6 +5410,12 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
   return hash_lookup_with_hash (h, key, hash_from_key (h, key));
 }
 
+ptrdiff_t
+weak_hash_lookup (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return weak_hash_lookup_with_hash (h, key, weak_hash_from_key (h, key));
+}
+
 /* Look up KEY in hash table H.  Return its hash value in *PHASH.
    Value is the index of the entry in H matching KEY, or -1 if not found.  */
 ptrdiff_t
@@ -5229,6 +5465,36 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
   return i;
 }
 
+/* Put an entry into weak hash table H that associates KEY with VALUE.
+   HASH is a previously computed hash code of KEY.
+   Value is the index of the entry in H matching KEY.  */
+
+ptrdiff_t
+weak_hash_put (struct Lisp_Weak_Hash_Table *h, Lisp_Object key, Lisp_Object value,
+	       hash_hash_t hash)
+{
+  //eassert (!hash_unused_entry_key_p (key));
+  /* Increment count after resizing because resizing may fail.  */
+  maybe_resize_weak_hash_table (h);
+  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) + 1);
+
+  /* Store key/value in the key_and_value vector.  */
+  ptrdiff_t i = XFIXNUM (h->strong->next_free);
+  //eassert (hash_unused_entry_key_p (HASH_KEY (h, i)));
+  h->strong->next_free = make_fixnum (WEAK_HASH_NEXT (h, i));
+  set_weak_hash_key_slot (h, i, key);
+  set_weak_hash_value_slot (h, i, value);
+
+  /* Remember its hash code.  */
+  set_weak_hash_hash_slot (h, i, hash);
+
+  /* Add new entry to its collision chain.  */
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  set_weak_hash_next_slot (h, i, WEAK_HASH_INDEX (h, start_of_bucket));
+  set_weak_hash_index_slot (h, start_of_bucket, i);
+  return i;
+}
+
 
 /* Remove the entry matching KEY from hash table H, if there is one.  */
 
@@ -5270,6 +5536,82 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
 }
 
 
+/* Remove the entry matching KEY from weak hash table H, if there is one.  */
+
+void
+weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  hash_hash_t hashval = weak_hash_from_key (h, key);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (EQ (key, WEAK_HASH_KEY (h, i))
+	  || (h->strong->test->cmpfn
+	      && hashval == WEAK_HASH_HASH (h, i)
+	      && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	  set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
+/* Remove the entry at ID0 from weak hash table H.  Called from GC with H
+   being a pointer to a structure on the stack. */
+
+void
+weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0)
+{
+  hash_hash_t hashval = WEAK_HASH_HASH (h, i0);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (i == i0)
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	  set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
 /* Clear hash table H.  */
 
 static void
@@ -5294,6 +5636,30 @@ hash_clear (struct Lisp_Hash_Table *h)
     }
 }
 
+/* Clear weak hash table H.  */
+
+static void
+weak_hash_clear (struct Lisp_Weak_Hash_Table *h)
+{
+  if (XFIXNUM (h->strong->count) > 0)
+    {
+      ptrdiff_t size = WEAK_HASH_TABLE_SIZE (h);
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  set_weak_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	}
+
+      ptrdiff_t index_size = weak_hash_table_index_size (h);
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	h->strong->index[i].lisp_object = make_fixnum (-1);
+
+      h->strong->next_free = make_fixnum (0);
+      h->strong->count = make_fixnum (0);
+    }
+}
+
 \f
 /************************************************************************
 			   Weak Hash Tables
@@ -5920,6 +6286,11 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
        doc: /* Return the number of elements in TABLE.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      return wh->strong->count;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   return make_fixnum (h->count);
 }
@@ -5999,7 +6370,7 @@ DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
        doc: /* Return t if OBJ is a Lisp hash table object.  */)
   (Lisp_Object obj)
 {
-  return HASH_TABLE_P (obj) ? Qt : Qnil;
+  return (HASH_TABLE_P (obj) || WEAK_HASH_TABLE_P (obj)) ? Qt : Qnil;
 }
 
 
@@ -6007,6 +6378,12 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
        doc: /* Clear hash table TABLE and return it.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_clear (wh);
+      return table;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_clear (h);
@@ -6020,6 +6397,12 @@ DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
 If KEY is not found, return DFLT which defaults to nil.  */)
   (Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      ptrdiff_t i = weak_hash_lookup (wh, key);
+      return i >= 0 ? WEAK_HASH_VALUE (wh, i) : dflt;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   ptrdiff_t i = hash_lookup (h, key);
   return i >= 0 ? HASH_VALUE (h, i) : dflt;
@@ -6032,6 +6415,17 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
 VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      EMACS_UINT hash = weak_hash_from_key (wh, key);
+      ptrdiff_t i = weak_hash_lookup_with_hash (wh, key, hash);
+      if (i >= 0)
+	set_weak_hash_value_slot (wh, i, value);
+      else
+	weak_hash_put (wh, key, value, hash);
+      return value;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
 
@@ -6050,6 +6444,12 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
        doc: /* Remove KEY from TABLE.  */)
   (Lisp_Object key, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_remove_from_table (wh, key);
+      return Qnil;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_remove_from_table (h, key);
@@ -6065,6 +6465,13 @@ DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
 `maphash' always returns nil.  */)
   (Lisp_Object function, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      DOHASH_WEAK_SAFE (wh, i)
+	call2 (function, WEAK_HASH_KEY (wh, i), WEAK_HASH_VALUE (wh, i));
+      return Qnil;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   /* We can't use DOHASH here since FUNCTION may violate the rules and
      we shouldn't crash as a result (although the effects are
diff --git a/src/igc.c b/src/igc.c
index 324bcfa112f..45e8c4ebd2a 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -350,7 +350,6 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "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",
@@ -372,6 +371,8 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_DUMPED_BUFFER_TEXT",
   "IGC_OBJ_DUMPED_BIGNUM_DATA",
   "IGC_OBJ_DUMPED_BYTES",
+  "IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART",
+  "IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART",
 };
 
 static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@@ -399,6 +400,7 @@ obj_type_name (enum igc_obj_type type)
   "PVEC_BOOL_VECTOR",
   "PVEC_BUFFER",
   "PVEC_HASH_TABLE",
+  "PVEC_WEAK_HASH_TABLE",
 #ifndef IN_MY_FORK
   "PVEC_OBARRAY",
 #endif
@@ -460,8 +462,8 @@ pvec_type_name (enum pvec_type type)
 
 enum
 {
-  IGC_TYPE_BITS = 5,
-  IGC_HASH_BITS = 27,
+  IGC_TYPE_BITS = 6,
+  IGC_HASH_BITS = 26,
   IGC_SIZE_BITS = 32,
   IGC_HASH_MASK = (1 << IGC_HASH_BITS) - 1,
 };
@@ -562,6 +564,32 @@ object_nelems (void *client, size_t elem_size)
   return obj_client_size (h) / elem_size;
 }
 
+Lisp_Object
+igc_ptr_to_lisp (void *client)
+{
+  if (client == 0)
+    return Qnil;
+  mps_addr_t base = client_to_base (client);
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_STRING:
+      return make_lisp_ptr (client, Lisp_String);
+
+    case IGC_OBJ_VECTOR:
+      return make_lisp_ptr (client, Lisp_Vectorlike);
+
+    case IGC_OBJ_CONS:
+      return make_lisp_ptr (client, Lisp_Cons);
+
+      return make_lisp_ptr (client, Lisp_Float);
+
+    default:
+      IGC_NOT_IMPLEMENTED ();
+      emacs_abort ();
+    }
+}
+
 /* Round NBYTES to the next multiple of ALIGN. */
 
 static size_t
@@ -636,8 +664,8 @@ IGC_DEFINE_LIST (igc_root);
   /* Allocation points for the thread. */
   mps_ap_t dflt_ap;
   mps_ap_t leaf_ap;
-  mps_ap_t weak_strong_ap;
-  mps_ap_t weak_weak_ap;
+  mps_ap_t weak_hash_strong_ap;
+  mps_ap_t weak_hash_weak_ap;
   mps_ap_t immovable_ap;
 
   /* Quick access to the roots used for specpdl, bytecode stack and
@@ -672,8 +700,8 @@ IGC_DEFINE_LIST (igc_thread);
   mps_pool_t dflt_pool;
   mps_fmt_t leaf_fmt;
   mps_pool_t leaf_pool;
-  mps_fmt_t weak_fmt;
-  mps_pool_t weak_pool;
+  mps_fmt_t weak_hash_fmt;
+  mps_pool_t weak_hash_pool;
   mps_fmt_t immovable_fmt;
   mps_pool_t immovable_pool;
 
@@ -1521,7 +1549,8 @@ fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes)
 }
 
 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
-static mps_res_t fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v);
+static mps_res_t fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t);
+static mps_res_t fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w);
 
 static mps_res_t
 dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
@@ -1608,10 +1637,6 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, client, fix_vector);
 	break;
 
-      case IGC_OBJ_VECTOR_WEAK:
-	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, client, fix_vector_weak);
-	break;
-
       case IGC_OBJ_ITREE_TREE:
 	IGC_FIX_CALL_FN (ss, struct itree_tree, client, fix_itree_tree);
 	break;
@@ -1645,6 +1670,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client,
 					     obj_size (header)));
 	break;
+
+      case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client,
+			 fix_weak_hash_table_strong_part);
+	break;
+      case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Weak_Part, client,
+			 fix_weak_hash_table_weak_part);
+	break;
       }
   }
   MPS_SCAN_END (ss);
@@ -1688,27 +1722,6 @@ fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
   return MPS_RES_OK;
 }
 
-static mps_res_t
-fix_marker_vector (mps_ss_t ss, struct Lisp_Vector *v)
-{
-  MPS_SCAN_BEGIN (ss)
-  {
-    for (size_t i = 0, n = vector_size (v); i < n; ++i)
-      {
-	Lisp_Object old = v->contents[i];
-	IGC_FIX12_OBJ (ss, &v->contents[i]);
-	/* FIXME/igc: this is right for marker vectors only.  */
-	if (NILP (v->contents[i]) && !NILP (old))
-	  {
-	    v->contents[i] = v->contents[0];
-	    v->contents[0] = make_fixnum (i);
-	  }
-      }
-  }
-  MPS_SCAN_END (ss);
-  return MPS_RES_OK;
-}
-
 static mps_res_t
 fix_buffer (mps_ss_t ss, struct buffer *b)
 {
@@ -1841,6 +1854,60 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &h->strong);
+    IGC_FIX12_RAW (ss, &h->weak);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	IGC_FIX12_OBJ (ss, &t->entries[i].lisp_object);
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &w->strong);
+    struct Lisp_Weak_Hash_Table_Strong_Part *t = w->strong;
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	bool was_nil = NILP (w->entries[i].lisp_object);
+	IGC_FIX12_OBJ (ss, &w->entries[i].lisp_object);
+	bool is_now_nil = NILP (w->entries[i].lisp_object);
+
+	if (is_now_nil && !was_nil)
+	  {
+	    struct Lisp_Weak_Hash_Table pseudo_h =
+	      {
+		.strong = t,
+		.weak = w,
+	      };
+	    weak_hash_splat_from_table (&pseudo_h, i);
+	  }
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t
 fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
 {
@@ -2133,6 +2200,10 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
 	IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
 	break;
 
+      case PVEC_WEAK_HASH_TABLE:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table, v, fix_weak_hash_table);
+	break;
+
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
 	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table);
@@ -2240,65 +2311,6 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
   return MPS_RES_OK;
 }
 
-static mps_res_t
-fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v)
-{
-  MPS_SCAN_BEGIN (ss)
-  {
-    switch (pseudo_vector_type (v))
-      {
-      case PVEC_NORMAL_VECTOR:
-	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_marker_vector);
-	break;
-
-#ifndef IN_MY_FORK
-      case PVEC_OBARRAY:
-#else
-      case PVEC_PACKAGE:
-#endif
-      case PVEC_BIGNUM:
-      case PVEC_BUFFER:
-      case PVEC_FRAME:
-      case PVEC_WINDOW:
-      case PVEC_HASH_TABLE:
-      case PVEC_CHAR_TABLE:
-      case PVEC_SUB_CHAR_TABLE:
-      case PVEC_BOOL_VECTOR:
-      case PVEC_OVERLAY:
-      case PVEC_SUBR:
-      case PVEC_FREE:
-      case PVEC_FINALIZER:
-      case PVEC_MISC_PTR:
-      case PVEC_USER_PTR:
-      case PVEC_XWIDGET:
-      case PVEC_XWIDGET_VIEW:
-      case PVEC_THREAD:
-      case PVEC_MUTEX:
-      case PVEC_TERMINAL:
-      case PVEC_MARKER:
-      case PVEC_NATIVE_COMP_UNIT:
-      case PVEC_MODULE_GLOBAL_REFERENCE:
-      case PVEC_TS_PARSER:
-      case PVEC_FONT:
-      case PVEC_SYMBOL_WITH_POS:
-      case PVEC_PROCESS:
-      case PVEC_WINDOW_CONFIGURATION:
-      case PVEC_MODULE_FUNCTION:
-      case PVEC_CONDVAR:
-      case PVEC_TS_COMPILED_QUERY:
-      case PVEC_TS_NODE:
-      case PVEC_SQLITE:
-      case PVEC_CLOSURE:
-      case PVEC_RECORD:
-      case PVEC_OTHER:
-	IGC_NOT_IMPLEMENTED ();
-	break;
-      }
-  }
-  MPS_SCAN_END (ss);
-  return MPS_RES_OK;
-}
-
 static igc_scan_result_t
 fix12_obj_callback (struct igc_opaque *op, Lisp_Object *addr)
 {
@@ -2549,11 +2561,11 @@ igc_root_destroy_comp_unit_eph (struct Lisp_Native_Comp_Unit *u)
 }
 
 static mps_res_t
-create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
+create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
 {
   struct igc *gc = t->gc;
   mps_res_t res;
-  mps_pool_t pool = gc->weak_pool;
+  mps_pool_t pool = gc->weak_hash_pool;
   MPS_ARGS_BEGIN (args)
   {
     MPS_ARGS_ADD (args, MPS_KEY_RANK,
@@ -2575,9 +2587,9 @@ create_thread_aps (struct igc_thread *t)
   IGC_CHECK_RES (res);
   res = mps_ap_create_k (&t->immovable_ap, gc->immovable_pool, mps_args_none);
   IGC_CHECK_RES (res);
-  res = create_weak_ap (&t->weak_strong_ap, t, false);
+  res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
   IGC_CHECK_RES (res);
-  res = create_weak_ap (&t->weak_weak_ap, t, true);
+  res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true);
   IGC_CHECK_RES (res);
 }
 
@@ -2635,8 +2647,8 @@ igc_thread_remove (void **pinfo)
   destroy_root (&t->d.bc_root);
   mps_ap_destroy (t->d.dflt_ap);
   mps_ap_destroy (t->d.leaf_ap);
-  mps_ap_destroy (t->d.weak_strong_ap);
-  mps_ap_destroy (t->d.weak_weak_ap);
+  mps_ap_destroy (t->d.weak_hash_strong_ap);
+  mps_ap_destroy (t->d.weak_hash_weak_ap);
   mps_ap_destroy (t->d.immovable_ap);
   mps_thread_dereg (deregister_thread (t));
 }
@@ -2956,6 +2968,7 @@ finalize_vector (mps_addr_t v)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_SYMBOL_WITH_POS:
     case PVEC_PROCESS:
     case PVEC_RECORD:
@@ -3005,6 +3018,8 @@ finalize (struct igc *gc, mps_addr_t base)
     case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_BYTES:
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
@@ -3029,7 +3044,6 @@ finalize (struct igc *gc, mps_addr_t base)
       break;
 
     case IGC_OBJ_VECTOR:
-    case IGC_OBJ_VECTOR_WEAK:
       finalize_vector (client);
       break;
     }
@@ -3060,6 +3074,7 @@ maybe_finalize (mps_addr_t client, enum pvec_type tag)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_NORMAL_VECTOR:
     case PVEC_FREE:
     case PVEC_MARKER:
@@ -3297,8 +3312,11 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
-    case IGC_OBJ_VECTOR_WEAK:
-      return t->d.weak_weak_ap;
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      return t->d.weak_hash_weak_ap;
+
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      return t->d.weak_hash_strong_ap;
 
     case IGC_OBJ_VECTOR:
     case IGC_OBJ_CONS:
@@ -3664,12 +3682,51 @@ igc_alloc_lisp_obj_vec (size_t n)
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_OBJ_VEC);
 }
 
+static mps_addr_t
+weak_hash_find_dependent (mps_addr_t base)
+{
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Weak_Part *w = client;
+	return client_to_base (w->strong);
+      }
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Strong_Part *w = client;
+	return client_to_base (w->weak);
+      }
+    default:
+      emacs_abort ();
+    }
+
+  return 0;
+}
+
 Lisp_Object *
 igc_make_hash_table_vec (size_t n)
 {
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC);
 }
 
+struct Lisp_Weak_Hash_Table_Strong_Part *
+igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART);
+}
+
+struct Lisp_Weak_Hash_Table_Weak_Part *
+igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART);
+}
+
 /* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only
    be used for growing a vector of pointers whose current size is N
    pointers.  */
@@ -3734,91 +3791,32 @@ igc_valid_lisp_object_p (Lisp_Object obj)
   return 1;
 }
 
-static Lisp_Object
-alloc_vector_weak (ptrdiff_t len, Lisp_Object init)
-{
-  struct Lisp_Vector *v
-    = alloc (header_size + len * word_size, IGC_OBJ_VECTOR_WEAK);
-  v->header.size = len;
-  for (ptrdiff_t i = 0; i < len; ++i)
-    v->contents[i] = init;
-  return make_lisp_ptr (v, Lisp_Vectorlike);
-}
-
-static Lisp_Object
-larger_marker_vector (Lisp_Object v)
-{
-  igc_assert (NILP (v) || (VECTORP (v) && XFIXNUM (AREF (v, 0)) < 0));
-  ptrdiff_t old_len = NILP (v) ? 0 : ASIZE (v);
-  ptrdiff_t new_len = max (2, 2 * old_len);
-  Lisp_Object new_v = alloc_vector_weak (new_len, Qnil);
-  ptrdiff_t i = 0;
-  if (VECTORP (v))
-    for (i = 1; i < ASIZE (v); ++i)
-      ASET (new_v, i, AREF (v, i));
-  for (; i < ASIZE (new_v) - 1; ++i)
-    ASET (new_v, i, make_fixnum (i + 1));
-  ASET (new_v, i, make_fixnum (-1));
-  ASET (new_v, 0, make_fixnum (NILP (v) ? 1 : ASIZE (v)));
-  return new_v;
-}
-
 void
 igc_add_marker (struct buffer *b, struct Lisp_Marker *m)
 {
   Lisp_Object v = BUF_MARKERS (b);
-  igc_assert (NILP (v) || VECTORP (v));
-  ptrdiff_t next_free = NILP (v) ? -1 : XFIXNUM (AREF (v, 0));
-  if (next_free < 0)
-    {
-      v = BUF_MARKERS (b) = larger_marker_vector (v);
-      next_free = XFIXNUM (AREF (v, 0));
-    }
-  ASET (v, 0, AREF (v, next_free));
-  ASET (v, next_free, make_lisp_ptr (m, Lisp_Vectorlike));
-  m->index = next_free;
-  m->buffer = b;
+  Fputhash (make_lisp_ptr (m, Lisp_Vectorlike), Qt, v);
 }
 
 void
 igc_remove_marker (struct buffer *b, struct Lisp_Marker *m)
 {
   Lisp_Object v = BUF_MARKERS (b);
-  igc_assert (VECTORP (v));
-  igc_assert (m->index >= 1 && m->index < ASIZE (v));
-  igc_assert (MARKERP (AREF (v, m->index)) && XMARKER (AREF (v, m->index)) == m);
-  ASET (v, m->index, AREF (v, 0));
-  ASET (v, 0, make_fixnum (m->index));
-  m->index = -1;
-  m->buffer = NULL;
+  Fremhash (make_lisp_ptr (m, Lisp_Vectorlike), v);
 }
 
 void
 igc_remove_all_markers (struct buffer *b)
 {
   Lisp_Object v = BUF_MARKERS (b);
-  if (VECTORP (v))
-    {
-      for (ptrdiff_t i = 1; i < ASIZE (v); ++i)
-	if (MARKERP (AREF (v, i)))
-	  XMARKER (AREF (v, i))->buffer = NULL;
-      BUF_MARKERS (b) = Qnil;
-    }
+  Fclrhash (v);
 }
 
 #ifdef IGC_DEBUG
 static bool
 weak_vector_p (Lisp_Object x)
 {
-  if (VECTORP (x))
-    {
-      struct igc *igc = global_igc;
-      mps_pool_t pool = NULL;
-      mps_addr_pool (&pool, igc->arena, XVECTOR (x));
-      return pool == igc->weak_pool;
-    }
-  else
-    return false;
+  return false;
 }
 #endif
 
@@ -3826,25 +3824,10 @@ weak_vector_p (Lisp_Object x)
 igc_resurrect_markers (struct buffer *b)
 {
   Lisp_Object old = BUF_MARKERS (b);
-  if (NILP (old))
-    return;
-  igc_assert (!weak_vector_p (old));
-  size_t len = ASIZE (old);
-  Lisp_Object new = alloc_vector_weak (len, Qnil);
-  memcpy (XVECTOR (new)->contents, XVECTOR (old)->contents,
-	  len * sizeof (Lisp_Object));
+  Lisp_Object new = make_hash_table (&hashtest_eq, 1024, Weak_Key, false);
+  DOHASH (XHASH_TABLE (old), k, v)
+    Fputhash (k, v, new);
   BUF_MARKERS (b) = new;
-  igc_assert (weak_vector_p (BUF_MARKERS (b)));
-}
-
-DEFUN ("igc-make-weak-vector", Figc_make_weak_vector, Sigc_make_weak_vector, 2, 2, 0,
-       doc: /* Return a new weak vector of length LENGTH, with each element being INIT.
-See also the function `vector'.  */)
-  (Lisp_Object length, Lisp_Object init)
-{
-  CHECK_TYPE (FIXNATP (length) && XFIXNAT (length) <= PTRDIFF_MAX,
-	      Qwholenump, length);
-  return alloc_vector_weak (XFIXNAT (length), init);
 }
 
 static void
@@ -3864,7 +3847,7 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   struct igc_stats st = { 0 };
   walk_pool (gc, gc->dflt_pool, &st);
   walk_pool (gc, gc->leaf_pool, &st);
-  walk_pool (gc, gc->weak_pool, &st);
+  walk_pool (gc, gc->weak_hash_pool, &st);
   walk_pool (gc, gc->immovable_pool, &st);
 
   Lisp_Object result = Qnil;
@@ -3964,7 +3947,7 @@ make_dflt_fmt (struct igc *gc)
 }
 
 static mps_pool_t
-make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
+make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls, mps_awl_find_dependent_t find_dependent)
 {
   mps_res_t res;
   mps_pool_t pool;
@@ -3973,6 +3956,8 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
     MPS_ARGS_ADD (args, MPS_KEY_FORMAT, fmt);
     MPS_ARGS_ADD (args, MPS_KEY_CHAIN, gc->chain);
     MPS_ARGS_ADD (args, MPS_KEY_INTERIOR, true);
+    if (find_dependent)
+      MPS_ARGS_ADD (args, MPS_KEY_AWL_FIND_DEPENDENT, find_dependent);
     res = mps_pool_create_k (&pool, gc->arena, cls, args);
   }
   MPS_ARGS_END (args);
@@ -3983,25 +3968,25 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
 static mps_pool_t
 make_pool_amc (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amc ());
+  return make_pool_with_class (gc, fmt, mps_class_amc (), NULL);
 }
 
 static mps_pool_t
 make_pool_ams (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_ams ());
+  return make_pool_with_class (gc, fmt, mps_class_ams (), NULL);
 }
 
 static mps_pool_t
-make_pool_awl (struct igc *gc, mps_fmt_t fmt)
+make_pool_awl (struct igc *gc, mps_fmt_t fmt, mps_awl_find_dependent_t find_dependent)
 {
-  return make_pool_with_class (gc, fmt, mps_class_awl ());
+  return make_pool_with_class (gc, fmt, mps_class_awl (), find_dependent);
 }
 
 static mps_pool_t
 make_pool_amcz (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amcz ());
+  return make_pool_with_class (gc, fmt, mps_class_amcz (), NULL);
 }
 
 static struct igc *
@@ -4019,8 +4004,8 @@ make_igc (void)
   gc->dflt_pool = make_pool_amc (gc, gc->dflt_fmt);
   gc->leaf_fmt = make_dflt_fmt (gc);
   gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt);
-  gc->weak_fmt = make_dflt_fmt (gc);
-  gc->weak_pool = make_pool_awl (gc, gc->weak_fmt);
+  gc->weak_hash_fmt = make_dflt_fmt (gc);
+  gc->weak_hash_pool = make_pool_awl (gc, gc->weak_hash_fmt, weak_hash_find_dependent);
   gc->immovable_fmt = make_dflt_fmt (gc);
   gc->immovable_pool = make_pool_ams (gc, gc->immovable_fmt);
 
@@ -4174,9 +4159,6 @@ igc_dump_finish_obj (void *client, enum igc_obj_type type,
       && !is_in_dump)
     {
       struct igc_header *h = client_to_base (client);
-      if (h->obj_type == IGC_OBJ_VECTOR_WEAK)
-	igc_assert ((type == IGC_OBJ_VECTOR && h->obj_type == IGC_OBJ_VECTOR_WEAK)
-		    || h->obj_type == type);
       igc_assert (base + obj_size (h) >= end);
       *out = *h;
       return base + obj_size (h);
@@ -4343,7 +4325,6 @@ init_igc (void)
 syms_of_igc (void)
 {
   defsubr (&Sigc_info);
-  defsubr (&Sigc_make_weak_vector);
   defsubr (&Sigc__roots);
   defsubr (&Sigc__collect);
   DEFSYM (Qambig, "ambig");
diff --git a/src/igc.h b/src/igc.h
index 95a0d25cbba..ec9705b939a 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -34,7 +34,6 @@ #define EMACS_IGC_H
   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,
@@ -56,6 +55,8 @@ #define EMACS_IGC_H
   IGC_OBJ_DUMPED_BUFFER_TEXT,
   IGC_OBJ_DUMPED_BIGNUM_DATA,
   IGC_OBJ_DUMPED_BYTES,
+  IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART,
+  IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART,
   IGC_OBJ_NUM_TYPES
 };
 
@@ -122,6 +123,8 @@ #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);
+struct Lisp_Weak_Hash_Table_Strong_Part *igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, size_t, size_t);
+struct Lisp_Weak_Hash_Table_Weak_Part *igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, size_t, size_t);
 void *igc_alloc_bytes (size_t nbytes);
 struct image_cache *igc_make_image_cache (void);
 struct interval *igc_make_interval (void);
diff --git a/src/lisp.h b/src/lisp.h
index 54f0a1715ea..525a87b01d9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1039,6 +1039,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
   PVEC_BOOL_VECTOR,
   PVEC_BUFFER,
   PVEC_HASH_TABLE,
+  PVEC_WEAK_HASH_TABLE,
   PVEC_OBARRAY,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
@@ -2558,6 +2559,7 @@ #define DOOBARRAY(oa, it)					\
 
 /* The structure of a Lisp hash table.  */
 
+struct Lisp_Weak_Hash_Table;
 struct Lisp_Hash_Table;
 struct hash_impl;
 
@@ -2605,6 +2607,55 @@ #define DOOBARRAY(oa, it)					\
    (hash) indices.  It's signed and a subtype of ptrdiff_t.  */
 typedef int32_t hash_idx_t;
 
+/* The reason for this unusual union is an MPS peculiarity on 32-bit x86 systems. */
+union Lisp_Weak_Hash_Table_Entry
+{
+  void *ptr;
+  Lisp_Object lisp_object; /* must be a fixnum or HASH_UNUSED_ENTRY_KEY! */
+};
+
+struct Lisp_Weak_Hash_Table_Strong_Part
+{
+  Lisp_Object index_bits;
+  Lisp_Object count;
+  Lisp_Object next_free;
+  Lisp_Object table_size;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  const struct hash_table_test *test;
+  union Lisp_Weak_Hash_Table_Entry *index; /* internal pointer */
+  union Lisp_Weak_Hash_Table_Entry *hash; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *next; /* internal pointer */
+  hash_table_weakness_t weakness : 3;
+  hash_table_std_test_t frozen_test : 2;
+
+  /* True if the table can be purecopied.  The table cannot be
+     changed afterwards.  */
+  bool_bf purecopy : 1;
+
+  /* True if the table is mutable.  Ordinarily tables are mutable, but
+     pure tables are not, and while a table is being mutated it is
+     immutable for recursive attempts to mutate it.  */
+  bool_bf mutable : 1;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table_Weak_Part
+{
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table
+{
+  union vectorlike_header header;
+
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  Lisp_Object dump_replacement;
+};
+
 struct Lisp_Hash_Table
 {
   union vectorlike_header header;
@@ -2725,6 +2776,23 @@ XHASH_TABLE (Lisp_Object a)
   return h;
 }
 
+INLINE bool
+WEAK_HASH_TABLE_P (Lisp_Object a)
+{
+  return PSEUDOVECTORP (a, PVEC_WEAK_HASH_TABLE);
+}
+
+INLINE struct Lisp_Weak_Hash_Table *
+XWEAK_HASH_TABLE (Lisp_Object a)
+{
+  eassert (WEAK_HASH_TABLE_P (a));
+  struct Lisp_Weak_Hash_Table *h
+    = XUNTAG (a, Lisp_Vectorlike, struct Lisp_Weak_Hash_Table);
+  igc_check_fwd (h);
+  return h;
+}
+
+extern Lisp_Object igc_ptr_to_lisp (void *ptr);
 INLINE Lisp_Object
 make_lisp_hash_table (struct Lisp_Hash_Table *h)
 {
@@ -2732,6 +2800,13 @@ make_lisp_hash_table (struct Lisp_Hash_Table *h)
   return make_lisp_ptr (h, Lisp_Vectorlike);
 }
 
+INLINE Lisp_Object
+make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_WEAK_HASH_TABLE));
+  return make_lisp_ptr (h, Lisp_Vectorlike);
+}
+
 /* Value is the key part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2740,6 +2815,14 @@ HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->key[idx];
 }
 
+/* Value is the key part of entry IDX in hash table H.  */
+INLINE Lisp_Object
+WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return h->strong->key[idx].lisp_object;
+}
+
 /* Value is the value part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2748,6 +2831,12 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->value[idx];
 }
 
+INLINE Lisp_Object
+WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  return h->strong->value[idx].lisp_object;
+}
+
 /* Value is the hash code computed for entry IDX in hash table H.  */
 INLINE hash_hash_t
 HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2756,6 +2845,14 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->hash[idx];
 }
 
+/* Value is the hash code computed for entry IDX in hash table H.  */
+INLINE hash_hash_t
+WEAK_HASH_HASH (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->hash[idx].lisp_object);
+}
+
 /* Value is the size of hash table H.  */
 INLINE ptrdiff_t
 HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
@@ -2763,6 +2860,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
   return h->table_size;
 }
 
+/* Value is the size of hash table H.  */
+INLINE ptrdiff_t
+WEAK_HASH_TABLE_SIZE (const struct Lisp_Weak_Hash_Table *h)
+{
+  return XFIXNUM (h->strong->table_size);
+}
+
 /* Size of the index vector in hash table H.  */
 INLINE ptrdiff_t
 hash_table_index_size (const struct Lisp_Hash_Table *h)
@@ -2770,6 +2874,12 @@ hash_table_index_size (const struct Lisp_Hash_Table *h)
   return (ptrdiff_t)1 << h->index_bits;
 }
 
+INLINE ptrdiff_t
+weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h)
+{
+  return (ptrdiff_t)1 << XFIXNUM (h->strong->index_bits);
+}
+
 /* Hash value for KEY in hash table H.  */
 INLINE hash_hash_t
 hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -2777,6 +2887,13 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
   return h->test->hashfn (key, h);
 }
 
+/* Hash value for KEY in hash table H.  */
+INLINE hash_hash_t
+weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return h->strong->test->hashfn (key, NULL);
+}
+
 /* Iterate K and V as key and value of valid entries in hash table H.
    The body may remove the current entry or alter its value slot, but not
    mutate TABLE in any other way.  */
@@ -2800,6 +2917,28 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
       ;									\
     else
 
+/* Iterate K and V as key and value of valid entries in hash table H.
+   The body may remove the current entry or alter its value slot, but not
+   mutate TABLE in any other way.  */
+# define DOHASH_WEAK(h, k, v)						\
+  for (union Lisp_Weak_Hash_Table_Entry *dohash_##k##_##v##_k = (h)->strong->key, \
+	 *dohash_##k##_##v##_v = (h)->strong->value,			\
+	 *dohash_##k##_##v##_end = dohash_##k##_##v##_k			\
+	 + WEAK_HASH_TABLE_SIZE (h),					\
+	 *dohash_##k##_##v##_base = dohash_##k##_##v##_k;		\
+       dohash_##k##_##v##_k < dohash_##k##_##v##_end			\
+	 && (k = dohash_##k##_##v##_k[0].lisp_object,			\
+	     v = dohash_##k##_##v##_v[0].lisp_object, /*maybe unused*/ (void)v,	\
+           true);			                                \
+       eassert (dohash_##k##_##v##_base == (h)->strong->key		\
+		&& dohash_##k##_##v##_end				\
+		   == dohash_##k##_##v##_base				\
+		+ WEAK_HASH_TABLE_SIZE (h)),				\
+	 ++dohash_##k##_##v##_k, ++dohash_##k##_##v##_v)		\
+    if (hash_unused_entry_key_p (k))					\
+      ;									\
+    else
+
 /* Iterate I as index of valid entries in hash table H.
    Unlike DOHASH, this construct copes with arbitrary table mutations
    in the body.  The consequences of such mutations are limited to
@@ -2812,6 +2951,18 @@ #define DOHASH_SAFE(h, i)					\
       ;								\
     else
 
+/* Iterate I as index of valid entries in hash table H.
+   Unlike DOHASH, this construct copes with arbitrary table mutations
+   in the body.  The consequences of such mutations are limited to
+   whether and in what order entries are encountered by the loop
+   (which is usually bad enough), but not crashing or corrupting the
+   Lisp state.  */
+#define DOHASH_WEAK_SAFE(h, i)					\
+  for (ptrdiff_t i = 0; i < WEAK_HASH_TABLE_SIZE (h); i++)	\
+    if (hash_unused_entry_key_p (WEAK_HASH_KEY (h, i)))		\
+      ;								\
+    else
+
 void hash_table_thaw (Lisp_Object hash_table);
 void hash_table_rehash (struct Lisp_Hash_Table *h);
 
@@ -4086,6 +4237,13 @@ set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->key[idx] = val;
 }
 
+INLINE void
+set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->key[idx].lisp_object = val;
+}
+
 INLINE void
 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
@@ -4093,6 +4251,13 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->value[idx] = val;;
 }
 
+INLINE void
+set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size) );
+  h->strong->value[idx].lisp_object = val;
+}
+
 /* Use these functions to set Lisp_Object
    or pointer slots of struct Lisp_Symbol.  */
 
@@ -4354,13 +4519,23 @@ #define CONS_TO_INTEGER(cons, type, var)				\
 EMACS_UINT sxhash (Lisp_Object);
 Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT,
                              hash_table_weakness_t, bool);
+Lisp_Object make_weak_hash_table (const struct hash_table_test *, EMACS_INT,
+				  hash_table_weakness_t, bool);
 Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak);
+Lisp_Object strengthen_hash_table (Lisp_Object weak);
+Lisp_Object strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *);
 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object);
+ptrdiff_t weak_hash_lookup (struct Lisp_Weak_Hash_Table *, Lisp_Object);
 ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key,
 				hash_hash_t *phash);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
 		    hash_hash_t);
+ptrdiff_t weak_hash_put (struct Lisp_Weak_Hash_Table *, Lisp_Object, Lisp_Object,
+			 hash_hash_t);
 void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
+void weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *, Lisp_Object);
+void weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0);
+
 extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
 extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
 			       ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
diff --git a/src/pdumper.c b/src/pdumper.c
index a560dd06ba8..8f4d3f3dc25 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1441,6 +1441,11 @@ dump_enqueue_object (struct dump_context *ctx,
                      Lisp_Object object,
                      struct link_weight weight)
 {
+  if (WEAK_HASH_TABLE_P (object))
+    {
+      strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (object));
+      object = XWEAK_HASH_TABLE (object)->dump_replacement;
+    }
   if (dump_object_needs_dumping_p (object))
     {
       dump_off state = dump_recall_object (ctx, object);
@@ -1943,6 +1948,11 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
       /* We don't know about the target object yet, so add a fixup.
          When we process the fixup, we'll have dumped the target
          object.  */
+      if (WEAK_HASH_TABLE_P (value))
+	{
+	  strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (value));
+	  value = XWEAK_HASH_TABLE (value)->dump_replacement;
+	}
       out_value = (intptr_t) 0xDEADF00D;
       dump_remember_fixup_lv (ctx,
                               out_field_offset,
@@ -3129,6 +3139,13 @@ dump_vectorlike (struct dump_context *ctx,
       return dump_vectorlike_generic (ctx, &v->header);
     case PVEC_BOOL_VECTOR:
       return dump_bool_vector(ctx, v);
+    case PVEC_WEAK_HASH_TABLE:
+      if (WEAK_HASH_TABLE_P (lv))
+	{
+	  strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (lv));
+	  lv = XWEAK_HASH_TABLE (lv)->dump_replacement;
+	}
+      return dump_hash_table (ctx, lv);
     case PVEC_HASH_TABLE:
       return dump_hash_table (ctx, lv);
     case PVEC_OBARRAY:
diff --git a/src/print.c b/src/print.c
index 2840252246f..f0453b72188 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2188,6 +2188,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_BIGNUM:
     case PVEC_BOOL_VECTOR:
     /* Impossible cases.  */
@@ -2786,6 +2787,54 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    goto next_obj;
 	  }
 
+	case PVEC_WEAK_HASH_TABLE:
+	  {
+	    struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj);
+	    /* Implement a readable output, e.g.:
+	       #s(hash-table test equal data (k1 v1 k2 v2)) */
+	    print_c_string ("#s(hash-table", printcharfun);
+
+	    if (!BASE_EQ (h->strong->test->name, Qeql))
+	      {
+		print_c_string (" test ", printcharfun);
+		print_object (h->strong->test->name, printcharfun, escapeflag);
+	      }
+
+	    if (h->strong->weakness != Weak_None)
+	      {
+		print_c_string (" weakness ", printcharfun);
+		print_object (hash_table_weakness_symbol (h->strong->weakness),
+			      printcharfun, escapeflag);
+	      }
+
+	    /* XXX: strengthen first, then count */
+	    ptrdiff_t size = XFIXNUM (h->strong->count);
+	    if (size > 0)
+	      {
+		print_c_string (" data (", printcharfun);
+
+		/* Don't print more elements than the specified maximum.  */
+		if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
+		  size = XFIXNAT (Vprint_length);
+
+		print_stack_push ((struct print_stack_entry){
+		    .type = PE_hash,
+		    .u.hash.obj = strengthen_hash_table (obj),
+		    .u.hash.nobjs = size * 2,
+		    .u.hash.idx = 0,
+		    .u.hash.printed = 0,
+		    .u.hash.truncated = (size < XFIXNUM (h->strong->count)),
+		  });
+	      }
+	    else
+	      {
+		/* Empty table: we can omit the data entirely.  */
+		printchar (')', printcharfun);
+		--print_depth;   /* Done with this.  */
+	      }
+	    goto next_obj;
+	  }
+
 	case PVEC_BIGNUM:
 	  print_bignum (obj, printcharfun);
 	  break;

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

> On Sunday, June 30th, 2024 at 13:15, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
>> Pip Cet pipcet@protonmail.com writes:
>> 
>> > > True. I forgot to mention an important thing: When something is splat,
>> > > set flag(s) in the dependent hash table indicating that something must
>> > > be done because of that splatting. In gethash and so, check the flag and
>> > > do what's necessary. (I did something similar for the weak hash tables
>> > > in CMUCL, and it wasn't entirely bad. And weak tables should be rare.)
>> > 
>> > Not necessarily rare, particularly not if we turn BUF_MARKERS into a
>> > weak hash table (I still don't see why we shouldn't do that, maybe I
>> > missed it).
>> 
>> 
>> Hm, don't know. On the one hand, there's Stefan's gap buffer data
>> structure, and on the other hand add_marker and remove_marker are now
>> O(1) in igc, modulo bugs. So the pressure has decreased.
>
> Well, I needed a weak hash table to test things on, which is why I've
> included the change in the attached patch.

Thanks! What do youo think about making a patch containing only your
weak hash tables, and leaving the BUF_MARKERS alone for now? That way
igc could support the existing uses of weak hash tables (I remember one
in the CLOS department somehwere), and they would be somewhat tested.
Don't remember if we have unit tests for them.

Re: MPS: dangling markers

[Pip Cet]

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

On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Thanks! What do youo think about making a patch containing only your
> weak hash tables, and leaving the BUF_MARKERS alone for now?

I think that's the best way forward. Patch attached.

> That way
> igc could support the existing uses of weak hash tables (I remember one
> in the CLOS department somehwere), and they would be somewhat tested.
> Don't remember if we have unit tests for them.

It seems MPS isn't very eager about splatting weak references during ordinary automatic GC, FWIW. What I'm observing with

(while t
  (dotimes (i 10000)
    (puthash (cons 1 2) (cons 3 4) table))
  (message "%S" (hash-table-count table))
  (sit-for 0.1))

is that the hash table starts out at 0, grows quickly, resets to count=0 once, then keeps growing and never splats any references after that. It's quite possible this is a bug in my code, of course.

Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-mps-weak-hash-tables.patch --]
[-- Type: text/x-patch; name=0003-mps-weak-hash-tables.patch, Size: 47583 bytes --]

diff --git a/src/alloc.c b/src/alloc.c
index 09b51ba2a08..5d47d3f7851 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6230,6 +6230,16 @@ purecopy (Lisp_Object obj)
 
       obj = make_lisp_hash_table (purecopy_hash_table (table));
     }
+  else if (WEAK_HASH_TABLE_P (obj))
+    {
+      /* Instead, add the hash table to the list of pinned objects,
+	 so that it will be marked during GC.  */
+      struct pinned_object *o = xmalloc (sizeof *o);
+      o->object = obj;
+      o->next = pinned_objects;
+      pinned_objects = o;
+      return obj; /* Don't hash cons it.  */
+    }
   else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
diff --git a/src/data.c b/src/data.c
index dcf869c1a0e..996f57e2123 100644
--- a/src/data.c
+++ b/src/data.c
@@ -251,6 +251,7 @@ DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
         case PVEC_BOOL_VECTOR: return Qbool_vector;
         case PVEC_FRAME: return Qframe;
         case PVEC_HASH_TABLE: return Qhash_table;
+        case PVEC_WEAK_HASH_TABLE: return Qhash_table;
         case PVEC_OBARRAY: return Qobarray;
         case PVEC_FONT:
           if (FONT_SPEC_P (object))
diff --git a/src/fns.c b/src/fns.c
index f7603626454..3049ae37d65 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4583,12 +4583,28 @@ set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   eassert (idx >= 0 && idx < h->table_size);
   h->next[idx] = val;
 }
+
+static void
+set_weak_hash_next_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->next[idx].lisp_object = make_fixnum (val);
+}
+
 static void
 set_hash_hash_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
 {
   eassert (idx >= 0 && idx < h->table_size);
   h->hash[idx] = val;
 }
+
+static void
+set_weak_hash_hash_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, hash_hash_t val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->hash[idx].lisp_object = make_fixnum (val);
+}
+
 static void
 set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
 {
@@ -4596,6 +4612,13 @@ set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
   h->index[idx] = val;
 }
 
+static void
+set_weak_hash_index_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  h->strong->index[idx].lisp_object = make_fixnum (val);
+}
+
 /* If OBJ is a Lisp hash table, return a pointer to its struct
    Lisp_Hash_Table.  Otherwise, signal an error.  */
 
@@ -4606,6 +4629,14 @@ check_hash_table (Lisp_Object obj)
   return XHASH_TABLE (obj);
 }
 
+static struct Lisp_Weak_Hash_Table *
+check_maybe_weak_hash_table (Lisp_Object obj)
+{
+  if (WEAK_HASH_TABLE_P (obj))
+    return XWEAK_HASH_TABLE (obj);
+  return NULL;
+}
+
 
 /* Value is the next integer I >= N, N >= 0 which is "almost" a prime
    number.  A number is "almost" a prime number if it is not divisible
@@ -4687,6 +4718,13 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->next[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_NEXT (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->next[idx].lisp_object);
+}
+
 /* Return the index of the element in hash table H that is the start
    of the collision list at index IDX, or -1 if the list is empty.  */
 
@@ -4697,6 +4735,13 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->index[idx];
 }
 
+static ptrdiff_t
+WEAK_HASH_INDEX (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < weak_hash_table_index_size (h));
+  return XFIXNUM (h->strong->index[idx].lisp_object);
+}
+
 /* Restore a hash table's mutability after the critical section exits.  */
 
 static void
@@ -4821,6 +4866,48 @@ allocate_hash_table (void)
   return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Hash_Table, PVEC_HASH_TABLE);
 }
 
+static struct Lisp_Weak_Hash_Table *
+allocate_weak_hash_table (hash_table_weakness_t weak, ssize_t size, ssize_t index_bits)
+{
+  struct Lisp_Weak_Hash_Table *ret =
+    ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+  ret->strong = igc_alloc_weak_hash_table_strong_part (weak, size, index_bits);
+  ret->strong->hash = ret->strong->entries + 0;
+  ret->strong->value = ret->strong->entries + 1 * size;
+  ret->strong->next = ret->strong->entries + 2 * size;
+  ret->strong->index = ret->strong->entries + 3 * size;
+  ret->weak = igc_alloc_weak_hash_table_weak_part (weak, size, index_bits);
+  ret->strong->weak = ret->weak;
+  ret->weak->strong = ret->strong;
+  ret->strong->key = ret->weak->entries;
+  return ret;
+}
+
+Lisp_Object
+strengthen_hash_table (Lisp_Object weak)
+{
+  Lisp_Object ret = make_hash_table (XWEAK_HASH_TABLE (weak)->strong->test, 0, Weak_None, 0);
+
+  Lisp_Object k, v;
+  DOHASH_WEAK (XWEAK_HASH_TABLE (weak), k, v)
+    {
+      Fputhash (k, v, ret);
+    }
+
+  return ret;
+}
+
+Lisp_Object
+strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *weak)
+{
+  if (!NILP (weak->dump_replacement))
+    return weak->dump_replacement;
+  Lisp_Object ret = strengthen_hash_table (make_lisp_weak_hash_table (weak));
+  weak->dump_replacement = ret;
+
+  return ret;
+}
+
 /* Compute the size of the index (as log2) from the table capacity.  */
 static int
 compute_hash_index_bits (hash_idx_t size)
@@ -4855,6 +4942,54 @@ compute_hash_index_bits (hash_idx_t size)
    `purecopy' when Emacs is being dumped. Such tables can no longer be
    changed after purecopy.  */
 
+Lisp_Object
+make_weak_hash_table (const struct hash_table_test *test, EMACS_INT size,
+		      hash_table_weakness_t weak, bool purecopy)
+{
+  eassert (!purecopy);
+  eassert (SYMBOLP (test->name));
+  eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
+
+  if (size < 65)
+    size = 65;
+
+  struct Lisp_Weak_Hash_Table *h = allocate_weak_hash_table (weak, size, compute_hash_index_bits (size));
+
+  h->strong->test = test;
+  h->strong->weakness = weak;
+  h->strong->count = make_fixnum (0);
+  h->strong->table_size = make_fixnum (size);
+
+  if (size == 0)
+    {
+      emacs_abort ();
+    }
+  else
+    {
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  h->strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  h->strong->value[i].ptr = 0;
+	}
+
+      for (ptrdiff_t i = 0; i < size - 1; i++)
+	h->strong->next[i].lisp_object = make_fixnum(i + 1);
+      h->strong->next[size - 1].lisp_object = make_fixnum(-1);
+
+      int index_bits = compute_hash_index_bits (size);
+      h->strong->index_bits = make_fixnum (index_bits);
+      ptrdiff_t index_size = weak_hash_table_index_size (h);
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	h->strong->index[i].lisp_object = make_fixnum (-1);
+
+      h->strong->next_free = make_fixnum (0);
+    }
+
+  h->strong->purecopy = purecopy;
+  h->strong->mutable = true;
+  return make_lisp_weak_hash_table (h);
+}
+
 Lisp_Object
 make_hash_table (const struct hash_table_test *test, EMACS_INT size,
 		 hash_table_weakness_t weak, bool purecopy)
@@ -4862,6 +4997,10 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size,
   eassert (SYMBOLP (test->name));
   eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
 
+  if (weak != Weak_None)
+    {
+      return make_weak_hash_table (test, size, weak, purecopy);
+    }
   struct Lisp_Hash_Table *h = allocate_hash_table ();
 
   h->test = test;
@@ -4961,6 +5100,13 @@ hash_index_index (struct Lisp_Hash_Table *h, hash_hash_t hash)
   return knuth_hash (hash, h->index_bits);
 }
 
+/* Compute index into the index vector from a hash value.  */
+static inline ptrdiff_t
+weak_hash_index_index (struct Lisp_Weak_Hash_Table *h, hash_hash_t hash)
+{
+  return knuth_hash (hash, XFIXNUM (h->strong->index_bits));
+}
+
 /* Resize hash table H if it's too full.  If H cannot be resized
    because it's already too large, throw an error.  */
 
@@ -5042,6 +5188,71 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
     }
 }
 
+static void
+maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  if (XFIXNUM (h->strong->next_free) < 0)
+    {
+      ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
+      ptrdiff_t min_size = 6;
+      ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
+      /* Grow aggressively at small sizes, then just double.  */
+      ptrdiff_t new_size =
+	old_size == 0
+	? min_size
+	: (base_size <= 64 ? base_size * 4 : base_size * 2);
+
+      ptrdiff_t index_bits = compute_hash_index_bits (new_size);
+
+      struct Lisp_Weak_Hash_Table_Strong_Part *strong =
+	igc_alloc_weak_hash_table_strong_part (h->strong->weakness, new_size, index_bits);
+      struct Lisp_Weak_Hash_Table_Weak_Part *weak =
+	igc_alloc_weak_hash_table_weak_part (h->strong->weakness, new_size, index_bits);
+
+      memcpy (strong, h->strong, sizeof *strong);
+
+      strong->hash = strong->entries + 0;
+      strong->value = strong->entries + 1 * new_size;
+      strong->next = strong->entries + 2 * new_size;
+      strong->index = strong->entries + 3 * new_size;
+      strong->key = weak->entries;
+      strong->count = make_fixnum (0);
+      weak->strong = strong;
+      strong->weak = weak;
+
+      for (ptrdiff_t i = 0; i < new_size - 1; i++)
+	strong->next[i].lisp_object = make_fixnum (i + 1);
+      strong->next[new_size - 1].lisp_object = make_fixnum (-1);
+
+      for (ptrdiff_t i = 0; i < new_size; i++)
+	{
+	  strong->key[i].lisp_object = HASH_UNUSED_ENTRY_KEY;
+	  strong->value[i].lisp_object = Qnil;
+	}
+
+      ptrdiff_t index_size = (ptrdiff_t)1 << index_bits;
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	strong->index[i].lisp_object = make_fixnum (-1);
+
+      strong->index_bits = make_fixnum (index_bits);
+      strong->table_size = make_fixnum (new_size);
+      strong->next_free = make_fixnum (0);
+
+      struct Lisp_Weak_Hash_Table *pseudo =
+	ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Weak_Hash_Table, PVEC_WEAK_HASH_TABLE);
+      pseudo->strong = strong;
+      pseudo->weak = weak;
+      Lisp_Object k, v;
+      DOHASH_WEAK (h, k, v)
+	{
+	  Fputhash (k, v, make_lisp_weak_hash_table (pseudo));
+	}
+
+      h->strong = strong;
+      h->weak = weak;
+    }
+}
+
 static const struct hash_table_test *
 hash_table_test_from_std (hash_table_std_test_t test)
 {
@@ -5058,6 +5269,7 @@ hash_table_test_from_std (hash_table_std_test_t test)
 void
 hash_table_thaw (Lisp_Object hash_table)
 {
+  eassert (HASH_TABLE_P (hash_table));
   struct Lisp_Hash_Table *h = XHASH_TABLE (hash_table);
 
   /* Freezing discarded most non-essential information; recompute it.
@@ -5173,6 +5385,24 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h,
   return -1;
 }
 
+/* Look up KEY with hash HASH in weak hash table H.
+   Return entry index or -1 if none.  */
+static ptrdiff_t
+weak_hash_lookup_with_hash (struct Lisp_Weak_Hash_Table *h,
+			    Lisp_Object key, hash_hash_t hash)
+{
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i; i = WEAK_HASH_NEXT (h, i))
+    if (EQ (key, WEAK_HASH_KEY (h, i))
+	|| (h->strong->test->cmpfn
+	    && hash == WEAK_HASH_HASH (h, i)
+	    && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+      return i;
+
+  return -1;
+}
+
 /* Look up KEY in table H.  Return entry index or -1 if none.  */
 ptrdiff_t
 hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -5180,6 +5410,12 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key)
   return hash_lookup_with_hash (h, key, hash_from_key (h, key));
 }
 
+ptrdiff_t
+weak_hash_lookup (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return weak_hash_lookup_with_hash (h, key, weak_hash_from_key (h, key));
+}
+
 /* Look up KEY in hash table H.  Return its hash value in *PHASH.
    Value is the index of the entry in H matching KEY, or -1 if not found.  */
 ptrdiff_t
@@ -5229,6 +5465,36 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
   return i;
 }
 
+/* Put an entry into weak hash table H that associates KEY with VALUE.
+   HASH is a previously computed hash code of KEY.
+   Value is the index of the entry in H matching KEY.  */
+
+ptrdiff_t
+weak_hash_put (struct Lisp_Weak_Hash_Table *h, Lisp_Object key, Lisp_Object value,
+	       hash_hash_t hash)
+{
+  //eassert (!hash_unused_entry_key_p (key));
+  /* Increment count after resizing because resizing may fail.  */
+  maybe_resize_weak_hash_table (h);
+  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) + 1);
+
+  /* Store key/value in the key_and_value vector.  */
+  ptrdiff_t i = XFIXNUM (h->strong->next_free);
+  //eassert (hash_unused_entry_key_p (HASH_KEY (h, i)));
+  h->strong->next_free = make_fixnum (WEAK_HASH_NEXT (h, i));
+  set_weak_hash_key_slot (h, i, key);
+  set_weak_hash_value_slot (h, i, value);
+
+  /* Remember its hash code.  */
+  set_weak_hash_hash_slot (h, i, hash);
+
+  /* Add new entry to its collision chain.  */
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hash);
+  set_weak_hash_next_slot (h, i, WEAK_HASH_INDEX (h, start_of_bucket));
+  set_weak_hash_index_slot (h, start_of_bucket, i);
+  return i;
+}
+
 
 /* Remove the entry matching KEY from hash table H, if there is one.  */
 
@@ -5270,6 +5536,82 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
 }
 
 
+/* Remove the entry matching KEY from weak hash table H, if there is one.  */
+
+void
+weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  hash_hash_t hashval = weak_hash_from_key (h, key);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (EQ (key, WEAK_HASH_KEY (h, i))
+	  || (h->strong->test->cmpfn
+	      && hashval == WEAK_HASH_HASH (h, i)
+	      && !NILP (h->strong->test->cmpfn (key, WEAK_HASH_KEY (h, i), NULL))))
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	  set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
+/* Remove the entry at ID0 from weak hash table H.  Called from GC with H
+   being a pointer to a structure on the stack. */
+
+void
+weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0)
+{
+  hash_hash_t hashval = WEAK_HASH_HASH (h, i0);
+  ptrdiff_t start_of_bucket = weak_hash_index_index (h, hashval);
+  ptrdiff_t prev = -1;
+
+  for (ptrdiff_t i = WEAK_HASH_INDEX (h, start_of_bucket);
+       0 <= i;
+       i = WEAK_HASH_NEXT (h, i))
+    {
+      if (i == i0)
+	{
+	  /* Take entry out of collision chain.  */
+	  if (prev < 0)
+	    set_weak_hash_index_slot (h, start_of_bucket, WEAK_HASH_NEXT (h, i));
+	  else
+	    set_weak_hash_next_slot (h, prev, WEAK_HASH_NEXT (h, i));
+
+	  /* Clear slots in key_and_value and add the slots to
+	     the free list.  */
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	  set_weak_hash_next_slot (h, i, XFIXNUM (h->strong->next_free));
+	  h->strong->next_free = make_fixnum (i);
+	  h->strong->count = make_fixnum (XFIXNUM (h->strong->count) - 1);
+	  break;
+	}
+
+      prev = i;
+    }
+}
+
+
 /* Clear hash table H.  */
 
 static void
@@ -5294,6 +5636,30 @@ hash_clear (struct Lisp_Hash_Table *h)
     }
 }
 
+/* Clear weak hash table H.  */
+
+static void
+weak_hash_clear (struct Lisp_Weak_Hash_Table *h)
+{
+  if (XFIXNUM (h->strong->count) > 0)
+    {
+      ptrdiff_t size = WEAK_HASH_TABLE_SIZE (h);
+      for (ptrdiff_t i = 0; i < size; i++)
+	{
+	  set_weak_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
+	  set_weak_hash_key_slot (h, i, HASH_UNUSED_ENTRY_KEY);
+	  set_weak_hash_value_slot (h, i, Qnil);
+	}
+
+      ptrdiff_t index_size = weak_hash_table_index_size (h);
+      for (ptrdiff_t i = 0; i < index_size; i++)
+	h->strong->index[i].lisp_object = make_fixnum (-1);
+
+      h->strong->next_free = make_fixnum (0);
+      h->strong->count = make_fixnum (0);
+    }
+}
+
 \f
 /************************************************************************
 			   Weak Hash Tables
@@ -5920,6 +6286,11 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
        doc: /* Return the number of elements in TABLE.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      return wh->strong->count;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   return make_fixnum (h->count);
 }
@@ -5999,7 +6370,7 @@ DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
        doc: /* Return t if OBJ is a Lisp hash table object.  */)
   (Lisp_Object obj)
 {
-  return HASH_TABLE_P (obj) ? Qt : Qnil;
+  return (HASH_TABLE_P (obj) || WEAK_HASH_TABLE_P (obj)) ? Qt : Qnil;
 }
 
 
@@ -6007,6 +6378,12 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
        doc: /* Clear hash table TABLE and return it.  */)
   (Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_clear (wh);
+      return table;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_clear (h);
@@ -6020,6 +6397,12 @@ DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
 If KEY is not found, return DFLT which defaults to nil.  */)
   (Lisp_Object key, Lisp_Object table, Lisp_Object dflt)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      ptrdiff_t i = weak_hash_lookup (wh, key);
+      return i >= 0 ? WEAK_HASH_VALUE (wh, i) : dflt;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   ptrdiff_t i = hash_lookup (h, key);
   return i >= 0 ? HASH_VALUE (h, i) : dflt;
@@ -6032,6 +6415,17 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
 VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      EMACS_UINT hash = weak_hash_from_key (wh, key);
+      ptrdiff_t i = weak_hash_lookup_with_hash (wh, key, hash);
+      if (i >= 0)
+	set_weak_hash_value_slot (wh, i, value);
+      else
+	weak_hash_put (wh, key, value, hash);
+      return value;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
 
@@ -6050,6 +6444,12 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
        doc: /* Remove KEY from TABLE.  */)
   (Lisp_Object key, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      weak_hash_remove_from_table (wh, key);
+      return Qnil;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   check_mutable_hash_table (table, h);
   hash_remove_from_table (h, key);
@@ -6065,6 +6465,13 @@ DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
 `maphash' always returns nil.  */)
   (Lisp_Object function, Lisp_Object table)
 {
+  struct Lisp_Weak_Hash_Table *wh = check_maybe_weak_hash_table (table);
+  if (wh)
+    {
+      DOHASH_WEAK_SAFE (wh, i)
+	call2 (function, WEAK_HASH_KEY (wh, i), WEAK_HASH_VALUE (wh, i));
+      return Qnil;
+    }
   struct Lisp_Hash_Table *h = check_hash_table (table);
   /* We can't use DOHASH here since FUNCTION may violate the rules and
      we shouldn't crash as a result (although the effects are
diff --git a/src/igc.c b/src/igc.c
index 2165a69cacf..482272e9a89 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -372,6 +372,8 @@ #define IGC_DEFINE_LIST(data)                                                  \
   "IGC_OBJ_DUMPED_BUFFER_TEXT",
   "IGC_OBJ_DUMPED_BIGNUM_DATA",
   "IGC_OBJ_DUMPED_BYTES",
+  "IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART",
+  "IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART",
 };
 
 static_assert (ARRAYELTS (obj_type_names) == IGC_OBJ_NUM_TYPES);
@@ -399,6 +401,7 @@ obj_type_name (enum igc_obj_type type)
   "PVEC_BOOL_VECTOR",
   "PVEC_BUFFER",
   "PVEC_HASH_TABLE",
+  "PVEC_WEAK_HASH_TABLE",
 #ifndef IN_MY_FORK
   "PVEC_OBARRAY",
 #endif
@@ -460,8 +463,8 @@ pvec_type_name (enum pvec_type type)
 
 enum
 {
-  IGC_TYPE_BITS = 5,
-  IGC_HASH_BITS = 27,
+  IGC_TYPE_BITS = 6,
+  IGC_HASH_BITS = 26,
   IGC_SIZE_BITS = 32,
   IGC_HASH_MASK = (1 << IGC_HASH_BITS) - 1,
 };
@@ -562,6 +565,32 @@ object_nelems (void *client, size_t elem_size)
   return obj_client_size (h) / elem_size;
 }
 
+Lisp_Object
+igc_ptr_to_lisp (void *client)
+{
+  if (client == 0)
+    return Qnil;
+  mps_addr_t base = client_to_base (client);
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_STRING:
+      return make_lisp_ptr (client, Lisp_String);
+
+    case IGC_OBJ_VECTOR:
+      return make_lisp_ptr (client, Lisp_Vectorlike);
+
+    case IGC_OBJ_CONS:
+      return make_lisp_ptr (client, Lisp_Cons);
+
+      return make_lisp_ptr (client, Lisp_Float);
+
+    default:
+      IGC_NOT_IMPLEMENTED ();
+      emacs_abort ();
+    }
+}
+
 /* Round NBYTES to the next multiple of ALIGN. */
 
 static size_t
@@ -638,6 +667,8 @@ IGC_DEFINE_LIST (igc_root);
   mps_ap_t leaf_ap;
   mps_ap_t weak_strong_ap;
   mps_ap_t weak_weak_ap;
+  mps_ap_t weak_hash_strong_ap;
+  mps_ap_t weak_hash_weak_ap;
   mps_ap_t immovable_ap;
 
   /* Quick access to the roots used for specpdl, bytecode stack and
@@ -674,6 +705,8 @@ IGC_DEFINE_LIST (igc_thread);
   mps_pool_t leaf_pool;
   mps_fmt_t weak_fmt;
   mps_pool_t weak_pool;
+  mps_fmt_t weak_hash_fmt;
+  mps_pool_t weak_hash_pool;
   mps_fmt_t immovable_fmt;
   mps_pool_t immovable_pool;
 
@@ -1522,6 +1555,8 @@ fix_charset_table (mps_ss_t ss, struct charset *table, size_t nbytes)
 
 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v);
 static mps_res_t fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v);
+static mps_res_t fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t);
+static mps_res_t fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w);
 
 static mps_res_t
 dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
@@ -1645,6 +1680,15 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	IGC_FIX_CALL (ss, fix_charset_table (ss, (struct charset *)client,
 					     obj_size (header)));
 	break;
+
+      case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Strong_Part, client,
+			 fix_weak_hash_table_strong_part);
+	break;
+      case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table_Weak_Part, client,
+			 fix_weak_hash_table_weak_part);
+	break;
       }
   }
   MPS_SCAN_END (ss);
@@ -1841,6 +1885,60 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h)
   return MPS_RES_OK;
 }
 
+static mps_res_t
+fix_weak_hash_table (mps_ss_t ss, struct Lisp_Weak_Hash_Table *h)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &h->strong);
+    IGC_FIX12_RAW (ss, &h->weak);
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_strong_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Strong_Part *t)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	IGC_FIX12_OBJ (ss, &t->entries[i].lisp_object);
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
+static mps_res_t
+fix_weak_hash_table_weak_part (mps_ss_t ss, struct Lisp_Weak_Hash_Table_Weak_Part *w)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    IGC_FIX12_RAW (ss, &w->strong);
+    struct Lisp_Weak_Hash_Table_Strong_Part *t = w->strong;
+    for (ssize_t i = 0; i < 4 * XFIXNUM (t->table_size); i++)
+      {
+	bool was_nil = NILP (w->entries[i].lisp_object);
+	IGC_FIX12_OBJ (ss, &w->entries[i].lisp_object);
+	bool is_now_nil = NILP (w->entries[i].lisp_object);
+
+	if (is_now_nil && !was_nil)
+	  {
+	    struct Lisp_Weak_Hash_Table pseudo_h =
+	      {
+		.strong = t,
+		.weak = w,
+	      };
+	    weak_hash_splat_from_table (&pseudo_h, i);
+	  }
+      }
+  }
+  MPS_SCAN_END (ss);
+  return MPS_RES_OK;
+}
+
 static mps_res_t
 fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
 {
@@ -2133,6 +2231,10 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v)
 	IGC_FIX_CALL_FN (ss, struct Lisp_Hash_Table, v, fix_hash_table);
 	break;
 
+      case PVEC_WEAK_HASH_TABLE:
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Hash_Table, v, fix_weak_hash_table);
+	break;
+
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
 	IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table);
@@ -2261,6 +2363,7 @@ fix_vector_weak (mps_ss_t ss, struct Lisp_Vector *v)
       case PVEC_FRAME:
       case PVEC_WINDOW:
       case PVEC_HASH_TABLE:
+      case PVEC_WEAK_HASH_TABLE:
       case PVEC_CHAR_TABLE:
       case PVEC_SUB_CHAR_TABLE:
       case PVEC_BOOL_VECTOR:
@@ -2564,6 +2667,22 @@ create_weak_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
   return res;
 }
 
+static mps_res_t
+create_weak_hash_ap (mps_ap_t *ap, struct igc_thread *t, bool weak)
+{
+  struct igc *gc = t->gc;
+  mps_res_t res;
+  mps_pool_t pool = gc->weak_hash_pool;
+  MPS_ARGS_BEGIN (args)
+  {
+    MPS_ARGS_ADD (args, MPS_KEY_RANK,
+		  weak ? mps_rank_weak () : mps_rank_exact ());
+    res = mps_ap_create_k (ap, pool, args);
+  }
+  MPS_ARGS_END (args);
+  return res;
+}
+
 static void
 create_thread_aps (struct igc_thread *t)
 {
@@ -2576,8 +2695,10 @@ create_thread_aps (struct igc_thread *t)
   res = mps_ap_create_k (&t->immovable_ap, gc->immovable_pool, mps_args_none);
   IGC_CHECK_RES (res);
   res = create_weak_ap (&t->weak_strong_ap, t, false);
+  res = create_weak_hash_ap (&t->weak_hash_strong_ap, t, false);
   IGC_CHECK_RES (res);
   res = create_weak_ap (&t->weak_weak_ap, t, true);
+  res = create_weak_hash_ap (&t->weak_hash_weak_ap, t, true);
   IGC_CHECK_RES (res);
 }
 
@@ -2637,6 +2758,8 @@ igc_thread_remove (void **pinfo)
   mps_ap_destroy (t->d.leaf_ap);
   mps_ap_destroy (t->d.weak_strong_ap);
   mps_ap_destroy (t->d.weak_weak_ap);
+  mps_ap_destroy (t->d.weak_hash_strong_ap);
+  mps_ap_destroy (t->d.weak_hash_weak_ap);
   mps_ap_destroy (t->d.immovable_ap);
   mps_thread_dereg (deregister_thread (t));
 }
@@ -2956,6 +3079,7 @@ finalize_vector (mps_addr_t v)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_SYMBOL_WITH_POS:
     case PVEC_PROCESS:
     case PVEC_RECORD:
@@ -3005,6 +3129,8 @@ finalize (struct igc *gc, mps_addr_t base)
     case IGC_OBJ_DUMPED_BIGNUM_DATA:
     case IGC_OBJ_DUMPED_BYTES:
     case IGC_OBJ_BYTES:
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
     case IGC_OBJ_NUM_TYPES:
       emacs_abort ();
 
@@ -3060,6 +3186,7 @@ maybe_finalize (mps_addr_t client, enum pvec_type tag)
     case PVEC_OBARRAY:
 #endif
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_NORMAL_VECTOR:
     case PVEC_FREE:
     case PVEC_MARKER:
@@ -3300,6 +3427,12 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_VECTOR_WEAK:
       return t->d.weak_weak_ap;
 
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      return t->d.weak_hash_weak_ap;
+
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      return t->d.weak_hash_strong_ap;
+
     case IGC_OBJ_VECTOR:
     case IGC_OBJ_CONS:
     case IGC_OBJ_SYMBOL:
@@ -3664,12 +3797,51 @@ igc_alloc_lisp_obj_vec (size_t n)
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_OBJ_VEC);
 }
 
+static mps_addr_t
+weak_hash_find_dependent (mps_addr_t base)
+{
+  struct igc_header *h = base;
+  switch (h->obj_type)
+    {
+    case IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Weak_Part *w = client;
+	return client_to_base (w->strong);
+      }
+    case IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART:
+      {
+	mps_addr_t client = base_to_client (base);
+	struct Lisp_Weak_Hash_Table_Strong_Part *w = client;
+	return client_to_base (w->weak);
+      }
+    default:
+      emacs_abort ();
+    }
+
+  return 0;
+}
+
 Lisp_Object *
 igc_make_hash_table_vec (size_t n)
 {
   return alloc (n * sizeof (Lisp_Object), IGC_OBJ_HASH_VEC);
 }
 
+struct Lisp_Weak_Hash_Table_Strong_Part *
+igc_alloc_weak_hash_table_strong_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Strong_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART);
+}
+
+struct Lisp_Weak_Hash_Table_Weak_Part *
+igc_alloc_weak_hash_table_weak_part (hash_table_weakness_t weak, size_t size, size_t index_bits)
+{
+  return alloc (sizeof (struct Lisp_Weak_Hash_Table_Weak_Part) + 5 * size * sizeof (union Lisp_Weak_Hash_Table_Entry),
+		IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART);
+}
+
 /* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only
    be used for growing a vector of pointers whose current size is N
    pointers.  */
@@ -3865,6 +4037,7 @@ DEFUN ("igc-info", Figc_info, Sigc_info, 0, 0, 0, doc : /* */)
   walk_pool (gc, gc->dflt_pool, &st);
   walk_pool (gc, gc->leaf_pool, &st);
   walk_pool (gc, gc->weak_pool, &st);
+  walk_pool (gc, gc->weak_hash_pool, &st);
   walk_pool (gc, gc->immovable_pool, &st);
 
   Lisp_Object result = Qnil;
@@ -3964,7 +4137,7 @@ make_dflt_fmt (struct igc *gc)
 }
 
 static mps_pool_t
-make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
+make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls, mps_awl_find_dependent_t find_dependent)
 {
   mps_res_t res;
   mps_pool_t pool;
@@ -3973,6 +4146,8 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
     MPS_ARGS_ADD (args, MPS_KEY_FORMAT, fmt);
     MPS_ARGS_ADD (args, MPS_KEY_CHAIN, gc->chain);
     MPS_ARGS_ADD (args, MPS_KEY_INTERIOR, true);
+    if (find_dependent)
+      MPS_ARGS_ADD (args, MPS_KEY_AWL_FIND_DEPENDENT, find_dependent);
     res = mps_pool_create_k (&pool, gc->arena, cls, args);
   }
   MPS_ARGS_END (args);
@@ -3983,25 +4158,25 @@ make_pool_with_class (struct igc *gc, mps_fmt_t fmt, mps_class_t cls)
 static mps_pool_t
 make_pool_amc (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amc ());
+  return make_pool_with_class (gc, fmt, mps_class_amc (), NULL);
 }
 
 static mps_pool_t
 make_pool_ams (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_ams ());
+  return make_pool_with_class (gc, fmt, mps_class_ams (), NULL);
 }
 
 static mps_pool_t
-make_pool_awl (struct igc *gc, mps_fmt_t fmt)
+make_pool_awl (struct igc *gc, mps_fmt_t fmt, mps_awl_find_dependent_t find_dependent)
 {
-  return make_pool_with_class (gc, fmt, mps_class_awl ());
+  return make_pool_with_class (gc, fmt, mps_class_awl (), find_dependent);
 }
 
 static mps_pool_t
 make_pool_amcz (struct igc *gc, mps_fmt_t fmt)
 {
-  return make_pool_with_class (gc, fmt, mps_class_amcz ());
+  return make_pool_with_class (gc, fmt, mps_class_amcz (), NULL);
 }
 
 static struct igc *
@@ -4020,7 +4195,9 @@ make_igc (void)
   gc->leaf_fmt = make_dflt_fmt (gc);
   gc->leaf_pool = make_pool_amcz (gc, gc->leaf_fmt);
   gc->weak_fmt = make_dflt_fmt (gc);
-  gc->weak_pool = make_pool_awl (gc, gc->weak_fmt);
+  gc->weak_pool = make_pool_awl (gc, gc->weak_fmt, NULL);
+  gc->weak_hash_fmt = make_dflt_fmt (gc);
+  gc->weak_hash_pool = make_pool_awl (gc, gc->weak_hash_fmt, weak_hash_find_dependent);
   gc->immovable_fmt = make_dflt_fmt (gc);
   gc->immovable_pool = make_pool_ams (gc, gc->immovable_fmt);
 
diff --git a/src/igc.h b/src/igc.h
index 95a0d25cbba..036fec5e238 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -56,6 +56,8 @@ #define EMACS_IGC_H
   IGC_OBJ_DUMPED_BUFFER_TEXT,
   IGC_OBJ_DUMPED_BIGNUM_DATA,
   IGC_OBJ_DUMPED_BYTES,
+  IGC_OBJ_WEAK_HASH_TABLE_WEAK_PART,
+  IGC_OBJ_WEAK_HASH_TABLE_STRONG_PART,
   IGC_OBJ_NUM_TYPES
 };
 
@@ -122,6 +124,8 @@ #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);
+struct Lisp_Weak_Hash_Table_Strong_Part *igc_alloc_weak_hash_table_strong_part(hash_table_weakness_t, size_t, size_t);
+struct Lisp_Weak_Hash_Table_Weak_Part *igc_alloc_weak_hash_table_weak_part(hash_table_weakness_t, size_t, size_t);
 void *igc_alloc_bytes (size_t nbytes);
 struct image_cache *igc_make_image_cache (void);
 struct interval *igc_make_interval (void);
diff --git a/src/lisp.h b/src/lisp.h
index 54f0a1715ea..525a87b01d9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1039,6 +1039,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
   PVEC_BOOL_VECTOR,
   PVEC_BUFFER,
   PVEC_HASH_TABLE,
+  PVEC_WEAK_HASH_TABLE,
   PVEC_OBARRAY,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
@@ -2558,6 +2559,7 @@ #define DOOBARRAY(oa, it)					\
 
 /* The structure of a Lisp hash table.  */
 
+struct Lisp_Weak_Hash_Table;
 struct Lisp_Hash_Table;
 struct hash_impl;
 
@@ -2605,6 +2607,55 @@ #define DOOBARRAY(oa, it)					\
    (hash) indices.  It's signed and a subtype of ptrdiff_t.  */
 typedef int32_t hash_idx_t;
 
+/* The reason for this unusual union is an MPS peculiarity on 32-bit x86 systems. */
+union Lisp_Weak_Hash_Table_Entry
+{
+  void *ptr;
+  Lisp_Object lisp_object; /* must be a fixnum or HASH_UNUSED_ENTRY_KEY! */
+};
+
+struct Lisp_Weak_Hash_Table_Strong_Part
+{
+  Lisp_Object index_bits;
+  Lisp_Object count;
+  Lisp_Object next_free;
+  Lisp_Object table_size;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  const struct hash_table_test *test;
+  union Lisp_Weak_Hash_Table_Entry *index; /* internal pointer */
+  union Lisp_Weak_Hash_Table_Entry *hash; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *key; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *value; /* either internal pointer or pointer to dependent object */
+  union Lisp_Weak_Hash_Table_Entry *next; /* internal pointer */
+  hash_table_weakness_t weakness : 3;
+  hash_table_std_test_t frozen_test : 2;
+
+  /* True if the table can be purecopied.  The table cannot be
+     changed afterwards.  */
+  bool_bf purecopy : 1;
+
+  /* True if the table is mutable.  Ordinarily tables are mutable, but
+     pure tables are not, and while a table is being mutated it is
+     immutable for recursive attempts to mutate it.  */
+  bool_bf mutable : 1;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table_Weak_Part
+{
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  union Lisp_Weak_Hash_Table_Entry entries[FLEXIBLE_ARRAY_MEMBER];
+};
+
+struct Lisp_Weak_Hash_Table
+{
+  union vectorlike_header header;
+
+  struct Lisp_Weak_Hash_Table_Strong_Part *strong;
+  struct Lisp_Weak_Hash_Table_Weak_Part *weak;
+  Lisp_Object dump_replacement;
+};
+
 struct Lisp_Hash_Table
 {
   union vectorlike_header header;
@@ -2725,6 +2776,23 @@ XHASH_TABLE (Lisp_Object a)
   return h;
 }
 
+INLINE bool
+WEAK_HASH_TABLE_P (Lisp_Object a)
+{
+  return PSEUDOVECTORP (a, PVEC_WEAK_HASH_TABLE);
+}
+
+INLINE struct Lisp_Weak_Hash_Table *
+XWEAK_HASH_TABLE (Lisp_Object a)
+{
+  eassert (WEAK_HASH_TABLE_P (a));
+  struct Lisp_Weak_Hash_Table *h
+    = XUNTAG (a, Lisp_Vectorlike, struct Lisp_Weak_Hash_Table);
+  igc_check_fwd (h);
+  return h;
+}
+
+extern Lisp_Object igc_ptr_to_lisp (void *ptr);
 INLINE Lisp_Object
 make_lisp_hash_table (struct Lisp_Hash_Table *h)
 {
@@ -2732,6 +2800,13 @@ make_lisp_hash_table (struct Lisp_Hash_Table *h)
   return make_lisp_ptr (h, Lisp_Vectorlike);
 }
 
+INLINE Lisp_Object
+make_lisp_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
+{
+  eassert (PSEUDOVECTOR_TYPEP (&h->header, PVEC_WEAK_HASH_TABLE));
+  return make_lisp_ptr (h, Lisp_Vectorlike);
+}
+
 /* Value is the key part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2740,6 +2815,14 @@ HASH_KEY (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->key[idx];
 }
 
+/* Value is the key part of entry IDX in hash table H.  */
+INLINE Lisp_Object
+WEAK_HASH_KEY (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return h->strong->key[idx].lisp_object;
+}
+
 /* Value is the value part of entry IDX in hash table H.  */
 INLINE Lisp_Object
 HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2748,6 +2831,12 @@ HASH_VALUE (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->value[idx];
 }
 
+INLINE Lisp_Object
+WEAK_HASH_VALUE (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  return h->strong->value[idx].lisp_object;
+}
+
 /* Value is the hash code computed for entry IDX in hash table H.  */
 INLINE hash_hash_t
 HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2756,6 +2845,14 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
   return h->hash[idx];
 }
 
+/* Value is the hash code computed for entry IDX in hash table H.  */
+INLINE hash_hash_t
+WEAK_HASH_HASH (const struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  return XFIXNUM (h->strong->hash[idx].lisp_object);
+}
+
 /* Value is the size of hash table H.  */
 INLINE ptrdiff_t
 HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
@@ -2763,6 +2860,13 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
   return h->table_size;
 }
 
+/* Value is the size of hash table H.  */
+INLINE ptrdiff_t
+WEAK_HASH_TABLE_SIZE (const struct Lisp_Weak_Hash_Table *h)
+{
+  return XFIXNUM (h->strong->table_size);
+}
+
 /* Size of the index vector in hash table H.  */
 INLINE ptrdiff_t
 hash_table_index_size (const struct Lisp_Hash_Table *h)
@@ -2770,6 +2874,12 @@ hash_table_index_size (const struct Lisp_Hash_Table *h)
   return (ptrdiff_t)1 << h->index_bits;
 }
 
+INLINE ptrdiff_t
+weak_hash_table_index_size (const struct Lisp_Weak_Hash_Table *h)
+{
+  return (ptrdiff_t)1 << XFIXNUM (h->strong->index_bits);
+}
+
 /* Hash value for KEY in hash table H.  */
 INLINE hash_hash_t
 hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
@@ -2777,6 +2887,13 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
   return h->test->hashfn (key, h);
 }
 
+/* Hash value for KEY in hash table H.  */
+INLINE hash_hash_t
+weak_hash_from_key (struct Lisp_Weak_Hash_Table *h, Lisp_Object key)
+{
+  return h->strong->test->hashfn (key, NULL);
+}
+
 /* Iterate K and V as key and value of valid entries in hash table H.
    The body may remove the current entry or alter its value slot, but not
    mutate TABLE in any other way.  */
@@ -2800,6 +2917,28 @@ hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
       ;									\
     else
 
+/* Iterate K and V as key and value of valid entries in hash table H.
+   The body may remove the current entry or alter its value slot, but not
+   mutate TABLE in any other way.  */
+# define DOHASH_WEAK(h, k, v)						\
+  for (union Lisp_Weak_Hash_Table_Entry *dohash_##k##_##v##_k = (h)->strong->key, \
+	 *dohash_##k##_##v##_v = (h)->strong->value,			\
+	 *dohash_##k##_##v##_end = dohash_##k##_##v##_k			\
+	 + WEAK_HASH_TABLE_SIZE (h),					\
+	 *dohash_##k##_##v##_base = dohash_##k##_##v##_k;		\
+       dohash_##k##_##v##_k < dohash_##k##_##v##_end			\
+	 && (k = dohash_##k##_##v##_k[0].lisp_object,			\
+	     v = dohash_##k##_##v##_v[0].lisp_object, /*maybe unused*/ (void)v,	\
+           true);			                                \
+       eassert (dohash_##k##_##v##_base == (h)->strong->key		\
+		&& dohash_##k##_##v##_end				\
+		   == dohash_##k##_##v##_base				\
+		+ WEAK_HASH_TABLE_SIZE (h)),				\
+	 ++dohash_##k##_##v##_k, ++dohash_##k##_##v##_v)		\
+    if (hash_unused_entry_key_p (k))					\
+      ;									\
+    else
+
 /* Iterate I as index of valid entries in hash table H.
    Unlike DOHASH, this construct copes with arbitrary table mutations
    in the body.  The consequences of such mutations are limited to
@@ -2812,6 +2951,18 @@ #define DOHASH_SAFE(h, i)					\
       ;								\
     else
 
+/* Iterate I as index of valid entries in hash table H.
+   Unlike DOHASH, this construct copes with arbitrary table mutations
+   in the body.  The consequences of such mutations are limited to
+   whether and in what order entries are encountered by the loop
+   (which is usually bad enough), but not crashing or corrupting the
+   Lisp state.  */
+#define DOHASH_WEAK_SAFE(h, i)					\
+  for (ptrdiff_t i = 0; i < WEAK_HASH_TABLE_SIZE (h); i++)	\
+    if (hash_unused_entry_key_p (WEAK_HASH_KEY (h, i)))		\
+      ;								\
+    else
+
 void hash_table_thaw (Lisp_Object hash_table);
 void hash_table_rehash (struct Lisp_Hash_Table *h);
 
@@ -4086,6 +4237,13 @@ set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->key[idx] = val;
 }
 
+INLINE void
+set_weak_hash_key_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size));
+  h->strong->key[idx].lisp_object = val;
+}
+
 INLINE void
 set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 {
@@ -4093,6 +4251,13 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
   h->value[idx] = val;;
 }
 
+INLINE void
+set_weak_hash_value_slot (struct Lisp_Weak_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (idx >= 0 && idx < XFIXNUM (h->strong->table_size) );
+  h->strong->value[idx].lisp_object = val;
+}
+
 /* Use these functions to set Lisp_Object
    or pointer slots of struct Lisp_Symbol.  */
 
@@ -4354,13 +4519,23 @@ #define CONS_TO_INTEGER(cons, type, var)				\
 EMACS_UINT sxhash (Lisp_Object);
 Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT,
                              hash_table_weakness_t, bool);
+Lisp_Object make_weak_hash_table (const struct hash_table_test *, EMACS_INT,
+				  hash_table_weakness_t, bool);
 Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak);
+Lisp_Object strengthen_hash_table (Lisp_Object weak);
+Lisp_Object strengthen_hash_table_for_dump (struct Lisp_Weak_Hash_Table *);
 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object);
+ptrdiff_t weak_hash_lookup (struct Lisp_Weak_Hash_Table *, Lisp_Object);
 ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key,
 				hash_hash_t *phash);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
 		    hash_hash_t);
+ptrdiff_t weak_hash_put (struct Lisp_Weak_Hash_Table *, Lisp_Object, Lisp_Object,
+			 hash_hash_t);
 void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
+void weak_hash_remove_from_table (struct Lisp_Weak_Hash_Table *, Lisp_Object);
+void weak_hash_splat_from_table (struct Lisp_Weak_Hash_Table *h, ptrdiff_t i0);
+
 extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal;
 extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
 			       ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
diff --git a/src/pdumper.c b/src/pdumper.c
index a560dd06ba8..8f4d3f3dc25 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1441,6 +1441,11 @@ dump_enqueue_object (struct dump_context *ctx,
                      Lisp_Object object,
                      struct link_weight weight)
 {
+  if (WEAK_HASH_TABLE_P (object))
+    {
+      strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (object));
+      object = XWEAK_HASH_TABLE (object)->dump_replacement;
+    }
   if (dump_object_needs_dumping_p (object))
     {
       dump_off state = dump_recall_object (ctx, object);
@@ -1943,6 +1948,11 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
       /* We don't know about the target object yet, so add a fixup.
          When we process the fixup, we'll have dumped the target
          object.  */
+      if (WEAK_HASH_TABLE_P (value))
+	{
+	  strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (value));
+	  value = XWEAK_HASH_TABLE (value)->dump_replacement;
+	}
       out_value = (intptr_t) 0xDEADF00D;
       dump_remember_fixup_lv (ctx,
                               out_field_offset,
@@ -3129,6 +3139,13 @@ dump_vectorlike (struct dump_context *ctx,
       return dump_vectorlike_generic (ctx, &v->header);
     case PVEC_BOOL_VECTOR:
       return dump_bool_vector(ctx, v);
+    case PVEC_WEAK_HASH_TABLE:
+      if (WEAK_HASH_TABLE_P (lv))
+	{
+	  strengthen_hash_table_for_dump (XWEAK_HASH_TABLE (lv));
+	  lv = XWEAK_HASH_TABLE (lv)->dump_replacement;
+	}
+      return dump_hash_table (ctx, lv);
     case PVEC_HASH_TABLE:
       return dump_hash_table (ctx, lv);
     case PVEC_OBARRAY:
diff --git a/src/print.c b/src/print.c
index 2840252246f..f0453b72188 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2188,6 +2188,7 @@ print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_HASH_TABLE:
+    case PVEC_WEAK_HASH_TABLE:
     case PVEC_BIGNUM:
     case PVEC_BOOL_VECTOR:
     /* Impossible cases.  */
@@ -2786,6 +2787,54 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    goto next_obj;
 	  }
 
+	case PVEC_WEAK_HASH_TABLE:
+	  {
+	    struct Lisp_Weak_Hash_Table *h = XWEAK_HASH_TABLE (obj);
+	    /* Implement a readable output, e.g.:
+	       #s(hash-table test equal data (k1 v1 k2 v2)) */
+	    print_c_string ("#s(hash-table", printcharfun);
+
+	    if (!BASE_EQ (h->strong->test->name, Qeql))
+	      {
+		print_c_string (" test ", printcharfun);
+		print_object (h->strong->test->name, printcharfun, escapeflag);
+	      }
+
+	    if (h->strong->weakness != Weak_None)
+	      {
+		print_c_string (" weakness ", printcharfun);
+		print_object (hash_table_weakness_symbol (h->strong->weakness),
+			      printcharfun, escapeflag);
+	      }
+
+	    /* XXX: strengthen first, then count */
+	    ptrdiff_t size = XFIXNUM (h->strong->count);
+	    if (size > 0)
+	      {
+		print_c_string (" data (", printcharfun);
+
+		/* Don't print more elements than the specified maximum.  */
+		if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
+		  size = XFIXNAT (Vprint_length);
+
+		print_stack_push ((struct print_stack_entry){
+		    .type = PE_hash,
+		    .u.hash.obj = strengthen_hash_table (obj),
+		    .u.hash.nobjs = size * 2,
+		    .u.hash.idx = 0,
+		    .u.hash.printed = 0,
+		    .u.hash.truncated = (size < XFIXNUM (h->strong->count)),
+		  });
+	      }
+	    else
+	      {
+		/* Empty table: we can omit the data entirely.  */
+		printchar (')', printcharfun);
+		--print_depth;   /* Done with this.  */
+	      }
+	    goto next_obj;
+	  }
+
 	case PVEC_BIGNUM:
 	  print_bignum (obj, printcharfun);
 	  break;

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

> On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
>> Thanks! What do youo think about making a patch containing only your
>> weak hash tables, and leaving the BUF_MARKERS alone for now?
>
> I think that's the best way forward. Patch attached.

Could you please send me something from git format-patch? That way I'd
have commit message and your authorship would also be clear. Or even
better, if you have the rights could you please commit to the branch?

(The reason I'm pushing for Helmut is because he doesn't want commit
rights. I'm not the gatekeeper or something of that branch.)

>
>> That way
>> igc could support the existing uses of weak hash tables (I remember one
>> in the CLOS department somehwere), and they would be somewhat tested.
>> Don't remember if we have unit tests for them.
>
> It seems MPS isn't very eager about splatting weak references during
> ordinary automatic GC, FWIW. What I'm observing with
>
> (while t
>   (dotimes (i 10000)
>     (puthash (cons 1 2) (cons 3 4) table))
>   (message "%S" (hash-table-count table))
>   (sit-for 0.1))
>
> is that the hash table starts out at 0, grows quickly, resets to
> count=0 once, then keeps growing and never splats any references after
> that. It's quite possible this is a bug in my code, of course.

Yes, it's not eagerly splatting. Don't know. Which reminds me that I
wanted to look if the AWL pool maybe has some paramter that one could
set, or something else influences that, like the mortality rate of the
generation chain. Or something completely different.

Re: MPS: dangling markers

[Pip Cet]

On Monday, July 1st, 2024 at 04:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> Pip Cet pipcet@protonmail.com writes:
> 
> > On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann gerd.moellmann@gmail.com wrote:
> > 
> > > Thanks! What do youo think about making a patch containing only your
> > > weak hash tables, and leaving the BUF_MARKERS alone for now?
> > 
> > I think that's the best way forward. Patch attached.
> 
> Could you please send me something from git format-patch? That way I'd
> have commit message and your authorship would also be clear. Or even
> better, if you have the rights could you please commit to the branch?

I'll do that. Please let me know what I got wrong.

> > > That way
> > > igc could support the existing uses of weak hash tables (I remember one
> > > in the CLOS department somehwere), and they would be somewhat tested.
> > > Don't remember if we have unit tests for them.
> > 
> > It seems MPS isn't very eager about splatting weak references during
> > ordinary automatic GC, FWIW. What I'm observing with
> > 
> > (while t
> > (dotimes (i 10000)
> > (puthash (cons 1 2) (cons 3 4) table))
> > (message "%S" (hash-table-count table))
> > (sit-for 0.1))
> > 
> > is that the hash table starts out at 0, grows quickly, resets to
> > count=0 once, then keeps growing and never splats any references after
> > that. It's quite possible this is a bug in my code, of course.
> 
> Yes, it's not eagerly splatting. Don't know. Which reminds me that I
> wanted to look if the AWL pool maybe has some paramter that one could
> set, or something else influences that, like the mortality rate of the
> generation chain. Or something completely different.

I debugged this a little, and it turns out that when we alternate between two weak hash tables, splatting works fine. It seems that if MPS receives a SIGSEGV in a segment belonging to a weak hash table, it scans it in "exact" mode, not "weak" mode, in order to continue execution as soon as possible. That's how I read this comment in mps/trace.c:

 * If the trace band is EXACT then we scan EXACT. This might prevent
 * finalisation messages and may preserve objects pointed to only by weak
 * references but tough luck -- the mutator wants to look.

So I don't think this will be a problem in practice...

Pip

Re: MPS: dangling markers

[Gerd Möllmann]

Pip Cet <pipcet@protonmail.com> writes:

>> Could you please send me something from git format-patch? That way I'd
>> have commit message and your authorship would also be clear. Or even
>> better, if you have the rights could you please commit to the branch?
>
> I'll do that. Please let me know what I got wrong.

Very good 👍!

>> Yes, it's not eagerly splatting. Don't know. Which reminds me that I
>> wanted to look if the AWL pool maybe has some paramter that one could
>> set, or something else influences that, like the mortality rate of the
>> generation chain. Or something completely different.
>
> I debugged this a little, and it turns out that when we alternate
> between two weak hash tables, splatting works fine. It seems that if
> MPS receives a SIGSEGV in a segment belonging to a weak hash table, it
> scans it in "exact" mode, not "weak" mode, in order to continue
> execution as soon as possible. That's how I read this comment in
> mps/trace.c:
>
>  * If the trace band is EXACT then we scan EXACT. This might prevent
>  * finalisation messages and may preserve objects pointed to only by weak
>  * references but tough luck -- the mutator wants to look.
>
> So I don't think this will be a problem in practice...

Thanks, that is interesting!

Re: MPS: dangling markers

[Eli Zaretskii]

> Date: Mon, 01 Jul 2024 17:14:11 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: Ihor Radchenko <yantar92@posteo.net>, Eli Zaretskii <eliz@gnu.org>,
>  monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> 
> On Monday, July 1st, 2024 at 04:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> > Pip Cet pipcet@protonmail.com writes:
> > 
> > > On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann gerd.moellmann@gmail.com wrote:
> > > 
> > > > Thanks! What do youo think about making a patch containing only your
> > > > weak hash tables, and leaving the BUF_MARKERS alone for now?
> > > 
> > > I think that's the best way forward. Patch attached.
> > 
> > Could you please send me something from git format-patch? That way I'd
> > have commit message and your authorship would also be clear. Or even
> > better, if you have the rights could you please commit to the branch?
> 
> I'll do that. Please let me know what I got wrong.
> 
> > > > That way
> > > > igc could support the existing uses of weak hash tables (I remember one
> > > > in the CLOS department somehwere), and they would be somewhat tested.
> > > > Don't remember if we have unit tests for them.
> > > 
> > > It seems MPS isn't very eager about splatting weak references during
> > > ordinary automatic GC, FWIW. What I'm observing with
> > > 
> > > (while t
> > > (dotimes (i 10000)
> > > (puthash (cons 1 2) (cons 3 4) table))
> > > (message "%S" (hash-table-count table))
> > > (sit-for 0.1))
> > > 
> > > is that the hash table starts out at 0, grows quickly, resets to
> > > count=0 once, then keeps growing and never splats any references after
> > > that. It's quite possible this is a bug in my code, of course.
> > 
> > Yes, it's not eagerly splatting. Don't know. Which reminds me that I
> > wanted to look if the AWL pool maybe has some paramter that one could
> > set, or something else influences that, like the mortality rate of the
> > generation chain. Or something completely different.
> 
> I debugged this a little, and it turns out that when we alternate between two weak hash tables, splatting works fine. It seems that if MPS receives a SIGSEGV in a segment belonging to a weak hash table, it scans it in "exact" mode, not "weak" mode, in order to continue execution as soon as possible. That's how I read this comment in mps/trace.c:
> 
>  * If the trace band is EXACT then we scan EXACT. This might prevent
>  * finalisation messages and may preserve objects pointed to only by weak
>  * references but tough luck -- the mutator wants to look.
> 
> So I don't think this will be a problem in practice...

The 32-bit build of the branch is now broken: dumping dies with

  lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)

Here's the backtrace:

  lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)

  Thread 1 hit Breakpoint 1, terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
  443     {
  (gdb) bt
  #0  terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
  #1  0x009ca26d in die (
      msg=msg@entry=0xf6ee2d <i_fwd+1057> "!FIXNUM_OVERFLOW_P (n)",
      file=file@entry=0xf6edec <i_fwd+992> "lisp.h", line=line@entry=1241)
      at alloc.c:8356
  #2  0x009ff199 in make_fixnum (n=<optimized out>) at lisp.h:1241
  #3  0x00a0fdb8 in make_fixnum (n=<optimized out>) at fns.c:5620
  #4  maybe_resize_weak_hash_table (h=<optimized out>, h=<optimized out>)
      at fns.c:5598
  #5  weak_hash_put (h=<optimized out>, h@entry=0xb45c1b8, key=<optimized out>,
      key@entry=XIL(0xb46065b), value=<optimized out>,
      value@entry=XIL(0xa4088b8), hash=<optimized out>, hash@entry=3269884494)
      at fns.c:5665
  #6  0x00a0fed2 in Fputhash (key=XIL(0xb46065b), value=XIL(0xa4088b8),
      table=XIL(0xb45c1bd)) at fns.c:6453
  #7  0x00a4b55d in exec_byte_code (fun=XIL(0xf447a5), args_template=514,
      args_template@entry=0, nargs=3, nargs@entry=0, args=0x1a956144,
      args@entry=0x0) at lisp.h:759
  #8  0x00a4be43 in Fbyte_code (bytestr=<optimized out>, vector=XIL(0xb46027d),
      maxdepth=make_fixnum(6)) at bytecode.c:330
  #9  0x009fa6e8 in eval_sub (form=form@entry=XIL(0xb45feab)) at eval.c:2629
  #10 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
      infile0=infile0@entry=0x749f048,
      sourcename=sourcename@entry=XIL(0xb448914),
      printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
      readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
      end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
  #11 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
      nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
      at lisp.h:1194
  #12 0x009fa69b in eval_sub (form=form@entry=XIL(0xb4486ab)) at eval.c:2637
  #13 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
      infile0=infile0@entry=0x749f638,
      sourcename=sourcename@entry=XIL(0xa84807c),
      printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
      readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
      end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
  #14 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
      nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
      at lisp.h:1194
  #15 0x009fa69b in eval_sub (form=form@entry=XIL(0xa847d43)) at eval.c:2637
  #16 0x009fc7be in Feval (form=XIL(0xa847d43), lexical=lexical@entry=XIL(0x18))
      at eval.c:2482
  #17 0x0095593e in top_level_2 () at lisp.h:1194
  #18 0x009f4bc2 in internal_condition_case (
      bfun=bfun@entry=0x9558e0 <top_level_2>, handlers=handlers@entry=XIL(0x48),
      hfun=hfun@entry=0x95f47e <cmd_error>) at eval.c:1629
  #19 0x00956063 in top_level_1 (ignore=XIL(0)) at lisp.h:1194
  #20 0x009f4adc in internal_catch (tag=tag@entry=XIL(0x93d8),
      func=func@entry=0x95603a <top_level_1>, arg=arg@entry=XIL(0))
      at eval.c:1308
  #21 0x009556ff in command_loop () at lisp.h:1194
  #22 0x0095f039 in recursive_edit_1 () at keyboard.c:765
  #23 0x0095f329 in Frecursive_edit () at keyboard.c:848
  #24 0x00b9f109 in main (argc=<optimized out>, argv=<optimized out>)
      at emacs.c:2651

This code:

  static void
  maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
  {
    if (XFIXNUM (h->strong->next_free) < 0)
      {
	ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
	ptrdiff_t min_size = 6;
	ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
	/* Grow aggressively at small sizes, then just double.  */
	ptrdiff_t new_size =
	  old_size == 0
	  ? min_size
	  : (base_size <= 64 ? base_size * 4 : base_size * 2);

is unsafe, since AFAIU it could produce new_size = PTRDIFF_MAX, and
that cannot fit in a fixnum, not even on a 64-bit system (although in
a 32-bit build this is much easier to reach).  So this loop:

      for (ptrdiff_t i = 0; i < new_size - 1; i++)
	strong->next[i].lisp_object = make_fixnum (i + 1);

will then cause a fixnum overflow, which happens here.

Re: MPS: dangling markers

[Pip Cet]

On Monday, July 1st, 2024 at 18:50, Eli Zaretskii <eliz@gnu.org> wrote:
> The 32-bit build of the branch is now broken: dumping dies with

Thanks! Sorry about that.

> lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)
> 
> Here's the backtrace:
> 
> lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)
> 
> Thread 1 hit Breakpoint 1, terminate_due_to_signal (sig=sig@entry=22,
> backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
> 443 {
> (gdb) bt
> #0 terminate_due_to_signal (sig=sig@entry=22,
> backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
> #1 0x009ca26d in die (
> msg=msg@entry=0xf6ee2d <i_fwd+1057> "!FIXNUM_OVERFLOW_P (n)",
> 
> file=file@entry=0xf6edec <i_fwd+992> "lisp.h", line=line@entry=1241)
> 
> at alloc.c:8356
> #2 0x009ff199 in make_fixnum (n=<optimized out>) at lisp.h:1241
> 
> #3 0x00a0fdb8 in make_fixnum (n=<optimized out>) at fns.c:5620
> 
> #4 maybe_resize_weak_hash_table (h=<optimized out>, h=<optimized out>)
> 
> at fns.c:5598
> #5 weak_hash_put (h=<optimized out>, h@entry=0xb45c1b8, key=<optimized out>,
> 
> key@entry=XIL(0xb46065b), value=<optimized out>,
> 
> value@entry=XIL(0xa4088b8), hash=<optimized out>, hash@entry=3269884494)

The hash doesn't fit a fixnum... This is an optimized build, right, so that might be the problem? The abort() handler is probably shared between different code locations and we're actually hitting the abort at line 5676:

  set_weak_hash_hash_slot (h, i, hash);

> at fns.c:5665
> #6 0x00a0fed2 in Fputhash (key=XIL(0xb46065b), value=XIL(0xa4088b8),
> table=XIL(0xb45c1bd)) at fns.c:6453
> #7 0x00a4b55d in exec_byte_code (fun=XIL(0xf447a5), args_template=514,
> args_template@entry=0, nargs=3, nargs@entry=0, args=0x1a956144,
> args@entry=0x0) at lisp.h:759
> #8 0x00a4be43 in Fbyte_code (bytestr=<optimized out>, vector=XIL(0xb46027d),
> 
> maxdepth=make_fixnum(6)) at bytecode.c:330
> #9 0x009fa6e8 in eval_sub (form=form@entry=XIL(0xb45feab)) at eval.c:2629
> #10 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
> infile0=infile0@entry=0x749f048,
> sourcename=sourcename@entry=XIL(0xb448914),
> printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
> readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
> end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
> 
> #11 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
> 
> nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
> 
> at lisp.h:1194
> #12 0x009fa69b in eval_sub (form=form@entry=XIL(0xb4486ab)) at eval.c:2637
> #13 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
> infile0=infile0@entry=0x749f638,
> sourcename=sourcename@entry=XIL(0xa84807c),
> printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
> readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
> end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
> 
> #14 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
> 
> nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
> 
> at lisp.h:1194
> #15 0x009fa69b in eval_sub (form=form@entry=XIL(0xa847d43)) at eval.c:2637
> #16 0x009fc7be in Feval (form=XIL(0xa847d43), lexical=lexical@entry=XIL(0x18))
> at eval.c:2482
> #17 0x0095593e in top_level_2 () at lisp.h:1194
> #18 0x009f4bc2 in internal_condition_case (
> bfun=bfun@entry=0x9558e0 <top_level_2>, handlers=handlers@entry=XIL(0x48),
> 
> hfun=hfun@entry=0x95f47e <cmd_error>) at eval.c:1629
> 
> #19 0x00956063 in top_level_1 (ignore=XIL(0)) at lisp.h:1194
> #20 0x009f4adc in internal_catch (tag=tag@entry=XIL(0x93d8),
> func=func@entry=0x95603a <top_level_1>, arg=arg@entry=XIL(0))
> 
> at eval.c:1308
> #21 0x009556ff in command_loop () at lisp.h:1194
> #22 0x0095f039 in recursive_edit_1 () at keyboard.c:765
> #23 0x0095f329 in Frecursive_edit () at keyboard.c:848
> #24 0x00b9f109 in main (argc=<optimized out>, argv=<optimized out>)
> 
> at emacs.c:2651

What's the Lisp backtrace? It would be good to know which hash table it is and which hash function it uses.

> This code:
> 
> static void
> maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
> {
> if (XFIXNUM (h->strong->next_free) < 0)
> 
> {
> ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
> ptrdiff_t min_size = 6;
> ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
> /* Grow aggressively at small sizes, then just double. */
> ptrdiff_t new_size =
> old_size == 0
> ? min_size
> : (base_size <= 64 ? base_size * 4 : base_size * 2);
> 
> is unsafe, since AFAIU it could produce new_size = PTRDIFF_MAX, and
> that cannot fit in a fixnum, not even on a 64-bit system (although in
> a 32-bit build this is much easier to reach). So this loop:
> 
> for (ptrdiff_t i = 0; i < new_size - 1; i++)
> strong->next[i].lisp_object = make_fixnum (i + 1);
> 
> 
> will then cause a fixnum overflow, which happens here.

You're right, that code needs fixing. I'm not convinced that's the problem you actually ran into, though. Are you really using a hash table with PTRDIFF_MAX entries?

Sorry again
Pip "Setting up a 32-bit test environment"

Re: MPS: dangling markers

[Eli Zaretskii]

> Date: Mon, 01 Jul 2024 19:04:41 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: gerd.moellmann@gmail.com, yantar92@posteo.net, monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> 
> What's the Lisp backtrace? It would be good to know which hash table it is and which hash function it uses.

Can't show one, sorry: GDB hits an assertion violation while trying to
produce Lisp backtrace:

  Lisp Backtrace:

  eval.c:127: Emacs fatal error: assertion failed: pdl->kind == SPECPDL_BACKTRACE

  Thread 1 hit Breakpoint 1, terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
  443     {
  The program being debugged stopped while in a function called from GDB.
  Evaluation of the expression containing the function
  (backtrace_function) will be abandoned.
  When the function is done executing, GDB will silently stop.

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

> This code:
>
>   static void
>   maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
>   {
>     if (XFIXNUM (h->strong->next_free) < 0)
>       {
> 	ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
> 	ptrdiff_t min_size = 6;
> 	ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
> 	/* Grow aggressively at small sizes, then just double.  */
> 	ptrdiff_t new_size =
> 	  old_size == 0
> 	  ? min_size
> 	  : (base_size <= 64 ? base_size * 4 : base_size * 2);
>
> is unsafe, since AFAIU it could produce new_size = PTRDIFF_MAX, and
> that cannot fit in a fixnum, not even on a 64-bit system (although in
> a 32-bit build this is much easier to reach).  So this loop:

I think the code is essientially the same as for the existing hash
tables, which I assume works on 32 bits. Different is

 	ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);

so maybe WEAK_HASH_TABLE_SIZE gives a wrong value?

Re: MPS: dangling markers

[Eli Zaretskii]

> Date: Mon, 01 Jul 2024 17:14:11 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: Ihor Radchenko <yantar92@posteo.net>, Eli Zaretskii <eliz@gnu.org>,
>  monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> 
> On Monday, July 1st, 2024 at 04:22, Gerd Möllmann <gerd.moellmann@gmail.com> wrote:
> > Pip Cet pipcet@protonmail.com writes:
> > 
> > > On Sunday, June 30th, 2024 at 19:22, Gerd Möllmann gerd.moellmann@gmail.com wrote:
> > > 
> > > > Thanks! What do youo think about making a patch containing only your
> > > > weak hash tables, and leaving the BUF_MARKERS alone for now?
> > > 
> > > I think that's the best way forward. Patch attached.
> > 
> > Could you please send me something from git format-patch? That way I'd
> > have commit message and your authorship would also be clear. Or even
> > better, if you have the rights could you please commit to the branch?
> 
> I'll do that. Please let me know what I got wrong.
> 
> > > > That way
> > > > igc could support the existing uses of weak hash tables (I remember one
> > > > in the CLOS department somehwere), and they would be somewhat tested.
> > > > Don't remember if we have unit tests for them.
> > > 
> > > It seems MPS isn't very eager about splatting weak references during
> > > ordinary automatic GC, FWIW. What I'm observing with
> > > 
> > > (while t
> > > (dotimes (i 10000)
> > > (puthash (cons 1 2) (cons 3 4) table))
> > > (message "%S" (hash-table-count table))
> > > (sit-for 0.1))
> > > 
> > > is that the hash table starts out at 0, grows quickly, resets to
> > > count=0 once, then keeps growing and never splats any references after
> > > that. It's quite possible this is a bug in my code, of course.
> > 
> > Yes, it's not eagerly splatting. Don't know. Which reminds me that I
> > wanted to look if the AWL pool maybe has some paramter that one could
> > set, or something else influences that, like the mortality rate of the
> > generation chain. Or something completely different.
> 
> I debugged this a little, and it turns out that when we alternate between two weak hash tables, splatting works fine. It seems that if MPS receives a SIGSEGV in a segment belonging to a weak hash table, it scans it in "exact" mode, not "weak" mode, in order to continue execution as soon as possible. That's how I read this comment in mps/trace.c:
> 
>  * If the trace band is EXACT then we scan EXACT. This might prevent
>  * finalisation messages and may preserve objects pointed to only by weak
>  * references but tough luck -- the mutator wants to look.
> 
> So I don't think this will be a problem in practice...

The 32-bit build of the branch is now broken: dumping dies with

  lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)

Here's the backtrace:

  lisp.h:1241: Emacs fatal error: assertion failed: !FIXNUM_OVERFLOW_P (n)

  Thread 1 hit Breakpoint 1, terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
  443     {
  (gdb) bt
  #0  terminate_due_to_signal (sig=sig@entry=22,
      backtrace_limit=backtrace_limit@entry=2147483647) at emacs.c:443
  #1  0x009ca26d in die (
      msg=msg@entry=0xf6ee2d <i_fwd+1057> "!FIXNUM_OVERFLOW_P (n)",
      file=file@entry=0xf6edec <i_fwd+992> "lisp.h", line=line@entry=1241)
      at alloc.c:8356
  #2  0x009ff199 in make_fixnum (n=<optimized out>) at lisp.h:1241
  #3  0x00a0fdb8 in make_fixnum (n=<optimized out>) at fns.c:5620
  #4  maybe_resize_weak_hash_table (h=<optimized out>, h=<optimized out>)
      at fns.c:5598
  #5  weak_hash_put (h=<optimized out>, h@entry=0xb45c1b8, key=<optimized out>,
      key@entry=XIL(0xb46065b), value=<optimized out>,
      value@entry=XIL(0xa4088b8), hash=<optimized out>, hash@entry=3269884494)
      at fns.c:5665
  #6  0x00a0fed2 in Fputhash (key=XIL(0xb46065b), value=XIL(0xa4088b8),
      table=XIL(0xb45c1bd)) at fns.c:6453
  #7  0x00a4b55d in exec_byte_code (fun=XIL(0xf447a5), args_template=514,
      args_template@entry=0, nargs=3, nargs@entry=0, args=0x1a956144,
      args@entry=0x0) at lisp.h:759
  #8  0x00a4be43 in Fbyte_code (bytestr=<optimized out>, vector=XIL(0xb46027d),
      maxdepth=make_fixnum(6)) at bytecode.c:330
  #9  0x009fa6e8 in eval_sub (form=form@entry=XIL(0xb45feab)) at eval.c:2629
  #10 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
      infile0=infile0@entry=0x749f048,
      sourcename=sourcename@entry=XIL(0xb448914),
      printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
      readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
      end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
  #11 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
      nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
      at lisp.h:1194
  #12 0x009fa69b in eval_sub (form=form@entry=XIL(0xb4486ab)) at eval.c:2637
  #13 0x00a360c8 in readevalloop (readcharfun=readcharfun@entry=XIL(0x48a8),
      infile0=infile0@entry=0x749f638,
      sourcename=sourcename@entry=XIL(0xa84807c),
      printflag=printflag@entry=false, unibyte=unibyte@entry=XIL(0),
      readfun=readfun@entry=XIL(0), start=start@entry=XIL(0),
      end=<optimized out>, end@entry=XIL(0)) at lread.c:2541
  #14 0x00a36b1f in Fload (file=<optimized out>, noerror=XIL(0),
      nomessage=XIL(0), nosuffix=XIL(0), must_suffix=<optimized out>)
      at lisp.h:1194
  #15 0x009fa69b in eval_sub (form=form@entry=XIL(0xa847d43)) at eval.c:2637
  #16 0x009fc7be in Feval (form=XIL(0xa847d43), lexical=lexical@entry=XIL(0x18))
      at eval.c:2482
  #17 0x0095593e in top_level_2 () at lisp.h:1194
  #18 0x009f4bc2 in internal_condition_case (
      bfun=bfun@entry=0x9558e0 <top_level_2>, handlers=handlers@entry=XIL(0x48),
      hfun=hfun@entry=0x95f47e <cmd_error>) at eval.c:1629
  #19 0x00956063 in top_level_1 (ignore=XIL(0)) at lisp.h:1194
  #20 0x009f4adc in internal_catch (tag=tag@entry=XIL(0x93d8),
      func=func@entry=0x95603a <top_level_1>, arg=arg@entry=XIL(0))
      at eval.c:1308
  #21 0x009556ff in command_loop () at lisp.h:1194
  #22 0x0095f039 in recursive_edit_1 () at keyboard.c:765
  #23 0x0095f329 in Frecursive_edit () at keyboard.c:848
  #24 0x00b9f109 in main (argc=<optimized out>, argv=<optimized out>)
      at emacs.c:2651

This code:

  static void
  maybe_resize_weak_hash_table (struct Lisp_Weak_Hash_Table *h)
  {
    if (XFIXNUM (h->strong->next_free) < 0)
      {
	ptrdiff_t old_size = WEAK_HASH_TABLE_SIZE (h);
	ptrdiff_t min_size = 6;
	ptrdiff_t base_size = min (max (old_size, min_size), PTRDIFF_MAX / 2);
	/* Grow aggressively at small sizes, then just double.  */
	ptrdiff_t new_size =
	  old_size == 0
	  ? min_size
	  : (base_size <= 64 ? base_size * 4 : base_size * 2);

is unsafe, since AFAIU it could produce new_size = PTRDIFF_MAX, and
that cannot fit in a fixnum, not even on a 64-bit system (although in
a 32-bit build this is much easier to reach).  So this loop:

      for (ptrdiff_t i = 0; i < new_size - 1; i++)
	strong->next[i].lisp_object = make_fixnum (i + 1);

will then cause a fixnum overflow, which happens here.

However, using MOST_POSITIVE_FIXNUM instead of PTRDIFF_MAX doesn't
help, so something else is at work here.

Re: MPS: dangling markers

[Pip Cet]

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

On Monday, July 1st, 2024 at 18:56, Eli Zaretskii <eliz@gnu.org> wrote:
> The 32-bit build of the branch is now broken: dumping dies with

Sorry, it took me a while to reproduce this because the default build worked fine, I had to --enable-checking to get something like your error, though in my case it was clearly the set_weak_hash_hash_value call that was to blame.

I incorrectly assumed sxhash, Fsxhash, and the hash value in an equal-based hash table were all the same number; in reality, sxhash is 32 bits on a 32-bit system, 64 bits on a 64-bit system, Fsxhash is 30 bits on a 32-bit system, 62 bits on a 64-bit system, and the hash value is 32 bits on all systems.

Long story short, would you be able to try this patch and see whether you get a clean dump? I do here...

diff --git a/src/lisp.h b/src/lisp.h
index 0f5a5410081..75146bd7715 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2997,7 +2997,7 @@ SXHASH_REDUCE (EMACS_UINT x)
 reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
 {
   verify (sizeof x <= 2 * sizeof (hash_hash_t));
-  return (sizeof x == sizeof (hash_hash_t)
+  return 0x1fffffff & (sizeof x == sizeof (hash_hash_t)
 	  ? x
 	  : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
 }

Obviously that's not a permanent fix.

Thanks
Pip

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0004-mps-weak-hash-tables.patch --]
[-- Type: text/x-patch; name=0004-mps-weak-hash-tables.patch, Size: 431 bytes --]

diff --git a/src/lisp.h b/src/lisp.h
index 0f5a5410081..75146bd7715 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2997,7 +2997,7 @@ SXHASH_REDUCE (EMACS_UINT x)
 reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
 {
   verify (sizeof x <= 2 * sizeof (hash_hash_t));
-  return (sizeof x == sizeof (hash_hash_t)
+  return 0x1fffffff & (sizeof x == sizeof (hash_hash_t)
 	  ? x
 	  : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
 }

Re: MPS: dangling markers

[Eli Zaretskii]

> Date: Mon, 01 Jul 2024 21:08:07 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: gerd.moellmann@gmail.com, yantar92@posteo.net, monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> 
> Sorry, it took me a while to reproduce this because the default build worked fine, I had to --enable-checking to get something like your error, though in my case it was clearly the set_weak_hash_hash_value call that was to blame.
> 
> I incorrectly assumed sxhash, Fsxhash, and the hash value in an equal-based hash table were all the same number; in reality, sxhash is 32 bits on a 32-bit system, 64 bits on a 64-bit system, Fsxhash is 30 bits on a 32-bit system, 62 bits on a 64-bit system, and the hash value is 32 bits on all systems.
> 
> Long story short, would you be able to try this patch and see whether you get a clean dump? I do here...

Yes, this fixes the build, thanks.

Re: MPS: dangling markers

[Pip Cet]

On Tuesday, July 2nd, 2024 at 11:25, Eli Zaretskii <eliz@gnu.org> wrote:
> > Date: Mon, 01 Jul 2024 21:08:07 +0000
> 
> > From: Pip Cet pipcet@protonmail.com
> > Cc: gerd.moellmann@gmail.com, yantar92@posteo.net, monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> > 
> > Sorry, it took me a while to reproduce this because the default build worked fine, I had to --enable-checking to get something like your error, though in my case it was clearly the set_weak_hash_hash_value call that was to blame.
> > 
> > I incorrectly assumed sxhash, Fsxhash, and the hash value in an equal-based hash table were all the same number; in reality, sxhash is 32 bits on a 32-bit system, 64 bits on a 64-bit system, Fsxhash is 30 bits on a 32-bit system, 62 bits on a 64-bit system, and the hash value is 32 bits on all systems.
> > 
> > Long story short, would you be able to try this patch and see whether you get a clean dump? I do here...
> 
> 
> Yes, this fixes the build, thanks.

I've pushed a fix. I'm now doing precisely what Fsxhash does rather than simply trimming off bits until we fit into a fixnum.

Thanks again
Pip

Re: MPS: dangling markers

[Eli Zaretskii]

> Date: Wed, 03 Jul 2024 18:46:31 +0000
> From: Pip Cet <pipcet@protonmail.com>
> Cc: gerd.moellmann@gmail.com, yantar92@posteo.net, monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> 
> On Tuesday, July 2nd, 2024 at 11:25, Eli Zaretskii <eliz@gnu.org> wrote:
> > > Date: Mon, 01 Jul 2024 21:08:07 +0000
> > 
> > > From: Pip Cet pipcet@protonmail.com
> > > Cc: gerd.moellmann@gmail.com, yantar92@posteo.net, monnier@iro.umontreal.ca, emacs-devel@gnu.org, eller.helmut@gmail.com
> > > 
> > > Sorry, it took me a while to reproduce this because the default build worked fine, I had to --enable-checking to get something like your error, though in my case it was clearly the set_weak_hash_hash_value call that was to blame.
> > > 
> > > I incorrectly assumed sxhash, Fsxhash, and the hash value in an equal-based hash table were all the same number; in reality, sxhash is 32 bits on a 32-bit system, 64 bits on a 64-bit system, Fsxhash is 30 bits on a 32-bit system, 62 bits on a 64-bit system, and the hash value is 32 bits on all systems.
> > > 
> > > Long story short, would you be able to try this patch and see whether you get a clean dump? I do here...
> > 
> > 
> > Yes, this fixes the build, thanks.
> 
> I've pushed a fix. I'm now doing precisely what Fsxhash does rather than simply trimming off bits until we fit into a fixnum.

Thanks, the build succeeds now.

Re: MPS: dangling markers

[Stefan Monnier]

> Jup, it's point-marker for me. No idea who calls that so often.

I think the core of the problem, then, is that currently it's completely
normal to rely on the GC to "remove" markers we don't care about any
more instead of explicitly removing them when we don't need them any
more (with `move-marker`).

So if the GC takes a long time to call `unchain_dead_markers`, we end up
with a very large set of markers and it's not clear how to handle that
efficiently.

I understand that relying on a prompt collection of dead objects is
a bad idea, but we may have to try and make sure it's prompt enough
because of the legacy of code which relies on it when it comes
to markers.

If not, we'll have to work at a better data-structure able to handle
a large set of markers.  The `itree` would probably be our best best but
if we end up with many markers at the very same place (which seems
likely if we often call `point-marker`), we'll hit its worst case (where
it goes back to O(N) tho this N is only the number of markers at a given
position rather than the total number of markers).

[ Another option might be to have a kind of two-level set of markers,
  where we keep the "recently used" markers in one data structure
  (optimized for adding/removing/moving/gettingtheposition) and then we
  demote markers that have not been recently used to a secondary
  data-structure optimized for "low-cost long term maintenance", kind of
  a like an archive of markers which are predicted to be dead.  ]

[ BTW, for the bytes<->chars conversion, we could also use a plain array
  indexed by CHARPOS/CHUNKSIZE where instead of updating the entries
  upon text insertion/deletion we just truncate the array to the last
  still-valid entry before the point of insertion/deletion.  ]


        Stefan

Re: MPS: dangling markers

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Jup, it's point-marker for me. No idea who calls that so often.
>
> I think the core of the problem, then, is that currently it's completely
> normal to rely on the GC to "remove" markers we don't care about any
> more instead of explicitly removing them when we don't need them any
> more (with `move-marker`).
>
> So if the GC takes a long time to call `unchain_dead_markers`, we end up
> with a very large set of markers and it's not clear how to handle that
> efficiently.

Yes.

> I understand that relying on a prompt collection of dead objects is
> a bad idea, but we may have to try and make sure it's prompt enough
> because of the legacy of code which relies on it when it comes
> to markers.

I'm afraid the only way to force MPS to "splat", as they call it, weak
references it by requesting a full collection. Which I think we want
to avoid because that is not done concurrently, the client has to wait
for it to complete.

> If not, we'll have to work at a better data-structure able to handle
> a large set of markers.  The `itree` would probably be our best best but
> if we end up with many markers at the very same place (which seems
> likely if we often call `point-marker`), we'll hit its worst case (where
> it goes back to O(N) tho this N is only the number of markers at a given
> position rather than the total number of markers).

Exactly what I was afraid of after seeing the number of point-markers:
thousands of markers with the same position. And I agree that itree
doesn't help with that, it will degenerate, and we can as well use a
vector then.

I must admit that I'm currently out of ideas.

> [ Another option might be to have a kind of two-level set of markers,
>   where we keep the "recently used" markers in one data structure
>   (optimized for adding/removing/moving/gettingtheposition) and then we
>   demote markers that have not been recently used to a secondary
>   data-structure optimized for "low-cost long term maintenance", kind of
>   a like an archive of markers which are predicted to be dead.  ]
>
> [ BTW, for the bytes<->chars conversion, we could also use a plain array
>   indexed by CHARPOS/CHUNKSIZE where instead of updating the entries
>   upon text insertion/deletion we just truncate the array to the last
>   still-valid entry before the point of insertion/deletion.  ]
>
>
>         Stefan

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Ihor Radchenko <yantar92@posteo.net>,  Eli Zaretskii <eliz@gnu.org>,
>   emacs-devel@gnu.org,  eller.helmut@gmail.com
> Date: Sun, 30 Jun 2024 07:02:06 +0200
> 
> I must admit that I'm currently out of ideas.

That's okay: markers and the associated slowdown are not the most
urgent problems in the MPS build.  Far from that.  We can safely
shelve that problem until some ideas emerge, and get busy fixing the
really bad problems.

Re: MPS: dangling markers

[Stefan Monnier]

> I'm afraid the only way to force MPS to "splat", as they call it, weak
> references it by requesting a full collection. Which I think we want
> to avoid because that is not done concurrently, the client has to wait
> for it to complete.

We could trigger full GCs from an idle timer.


        Stefan

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Cc: Ihor Radchenko <yantar92@posteo.net>,  Eli Zaretskii <eliz@gnu.org>,
>  emacs-devel@gnu.org,  eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 18:59:15 -0400
> 
> > Jup, it's point-marker for me. No idea who calls that so often.
> 
> I think the core of the problem, then, is that currently it's completely
> normal to rely on the GC to "remove" markers we don't care about any
> more instead of explicitly removing them when we don't need them any
> more (with `move-marker`).
> 
> So if the GC takes a long time to call `unchain_dead_markers`, we end up
> with a very large set of markers and it's not clear how to handle that
> efficiently.
> 
> I understand that relying on a prompt collection of dead objects is
> a bad idea, but we may have to try and make sure it's prompt enough
> because of the legacy of code which relies on it when it comes
> to markers.
> 
> If not, we'll have to work at a better data-structure able to handle
> a large set of markers.  The `itree` would probably be our best best but
> if we end up with many markers at the very same place (which seems
> likely if we often call `point-marker`), we'll hit its worst case (where
> it goes back to O(N) tho this N is only the number of markers at a given
> position rather than the total number of markers).
> 
> [ Another option might be to have a kind of two-level set of markers,
>   where we keep the "recently used" markers in one data structure
>   (optimized for adding/removing/moving/gettingtheposition) and then we
>   demote markers that have not been recently used to a secondary
>   data-structure optimized for "low-cost long term maintenance", kind of
>   a like an archive of markers which are predicted to be dead.  ]
> 
> [ BTW, for the bytes<->chars conversion, we could also use a plain array
>   indexed by CHARPOS/CHUNKSIZE where instead of updating the entries
>   upon text insertion/deletion we just truncate the array to the last
>   still-valid entry before the point of insertion/deletion.  ]

All good idea, but I think they should take a back seat for now.  We
still have unresolved issues that cause crashes, like the one with
SIGPROF and SIGCHLD happening at the wrong time.  We should prioritize
solving those first.  Because a slower Emacs will still be usable
(especially if the slow-down happens only in some specific modes),
whereas an Emacs which crashes is not.

Let's not get distracted by issues that have secondary importance at
this stage.

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  monnier@iro.umontreal.ca,
>  emacs-devel@gnu.org,  eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 23:50:01 +0200
> 
> Ihor Radchenko <yantar92@posteo.net> writes:
> 
> >>> Sorry, I've asked not precisely enough. Do we know the percentage of
> >>> markers generated by that code? I mean, of the 500K markers Ihor sees,
> >>> how many could be spare?
> >>
> >> I don't know, but a simple instrumentation (or even just a suitably
> >> defined breakpoint) will tell.
> >
> > I looked into this. And it is near 0%. The overwhelming majority of the
> > markers are created by something else. I mostly saw save_excursion_save
> > in backtraces - it creates transient markers to save point position.
> 
> Jup, it's point-marker for me. No idea who calls that so often.

Org, who else?  Look at the backtrace.

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>,  monnier@iro.umontreal.ca,
>>  emacs-devel@gnu.org,  eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 23:50:01 +0200
>> 
>> Ihor Radchenko <yantar92@posteo.net> writes:
>> 
>> >>> Sorry, I've asked not precisely enough. Do we know the percentage of
>> >>> markers generated by that code? I mean, of the 500K markers Ihor sees,
>> >>> how many could be spare?
>> >>
>> >> I don't know, but a simple instrumentation (or even just a suitably
>> >> defined breakpoint) will tell.
>> >
>> > I looked into this. And it is near 0%. The overwhelming majority of the
>> > markers are created by something else. I mostly saw save_excursion_save
>> > in backtraces - it creates transient markers to save point position.
>> 
>> Jup, it's point-marker for me. No idea who calls that so often.
>
> Org, who else?  Look at the backtrace.

Ihor do you plead guilty? :-)

In the case when I made the histogram there were no org buffers
involved. It must be something different.

Re: MPS: dangling markers

[Ihor Radchenko]

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

>>> Jup, it's point-marker for me. No idea who calls that so often.
>>
>> Org, who else?  Look at the backtrace.
>
> Ihor do you plead guilty? :-)

Org mode uses `save-excursion' as lot. And `save-restriction'.
But Org mode is not unique in the Elisp world in this regard.

> In the case when I made the histogram there were no org buffers
> involved. It must be something different.

Saving point/narrowing is used often in Elisp. So, I am not surpised.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Ihor Radchenko]

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

> ... I don't know if the figure of 500K
> markers is real, but that sounds erm strange...

It was a casual 26+Mb buffer.
(point-max) ; => 26,897,873

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> ... I don't know if the figure of 500K
>> markers is real, but that sounds erm strange...
>
> It was a casual 26+Mb buffer.
> (point-max) ; => 26,897,873

Casual, eh?

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: Eli Zaretskii <eliz@gnu.org>,  monnier@iro.umontreal.ca,
>   emacs-devel@gnu.org,  eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 20:05:11 +0200
> 
> Ihor Radchenko <yantar92@posteo.net> writes:
> 
> > Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> >
> >> ... I don't know if the figure of 500K
> >> markers is real, but that sounds erm strange...
> >
> > It was a casual 26+Mb buffer.
> > (point-max) ; => 26,897,873
> 
> Casual, eh?

That's Org for you: they push Emacs to the extremes we never imagined
someone will need.

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: Eli Zaretskii <eliz@gnu.org>,  monnier@iro.umontreal.ca,
>>   emacs-devel@gnu.org,  eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 20:05:11 +0200
>> 
>> Ihor Radchenko <yantar92@posteo.net> writes:
>> 
>> > Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>> >
>> >> ... I don't know if the figure of 500K
>> >> markers is real, but that sounds erm strange...
>> >
>> > It was a casual 26+Mb buffer.
>> > (point-max) ; => 26,897,873
>> 
>> Casual, eh?
>
> That's Org for you: they push Emacs to the extremes we never imagined
> someone will need.

I bet he also has 2Mb long lines :-)

Re: MPS: dangling markers

[Ihor Radchenko]

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

>> That's Org for you: they push Emacs to the extremes we never imagined
>> someone will need.
>
> I bet he also has 2Mb long lines :-)

Nein.
Max line length: 5003

But some people who use json src blocks can have anything...

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>   eller.helmut@gmail.com
> Date: Sat, 29 Jun 2024 19:09:03 +0200
> 
> > I think we can use a completely different data structure for
> > character-to-byte conversions.  There's no need to use markers for
> > that, and there's no need to create extra markers.  We could instead
> > maintain an itree of positions with their character and byte values,
> > as a field of 'struct buffer' that is not exposed to Lisp.
> >
> > WDYT?
> 
> I must admit that my overview of that whole area is pretty limited.
> I only remember that markers were always kind of a problem :-).
> 
> Would such a data structure be similar to recording deletions/insertions
> of buffer text?

No, just pairs of character position and the corresponding byte
position.

> Anyway, it's a lot of work, of course.

But the itree structure and the supporting code already exist, so why
would that be a lot of work?

Re: MPS: dangling markers

[Gerd Möllmann]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Gerd Möllmann <gerd.moellmann@gmail.com>
>> Cc: yantar92@posteo.net,  monnier@iro.umontreal.ca,  emacs-devel@gnu.org,
>>   eller.helmut@gmail.com
>> Date: Sat, 29 Jun 2024 19:09:03 +0200
>> 
>> > I think we can use a completely different data structure for
>> > character-to-byte conversions.  There's no need to use markers for
>> > that, and there's no need to create extra markers.  We could instead
>> > maintain an itree of positions with their character and byte values,
>> > as a field of 'struct buffer' that is not exposed to Lisp.
>> >
>> > WDYT?
>> 
>> I must admit that my overview of that whole area is pretty limited.
>> I only remember that markers were always kind of a problem :-).
>> 
>> Would such a data structure be similar to recording deletions/insertions
>> of buffer text?
>
> No, just pairs of character position and the corresponding byte
> position.
>
>> Anyway, it's a lot of work, of course.
>
> But the itree structure and the supporting code already exist, so why
> would that be a lot of work?

For sure more work than concocting a DO_MARKERS :-).

Re: MPS: dangling markers

[Stefan Monnier]

>>     36.34%  emacs         emacs                                          [.] igc_remove_marker
>>     35.77%  emacs         emacs                                          [.] igc_add_marker

I don't understand this:

- Why is `igc_remove_marker` slower than `unchain_marker`?
  `unchain_marker` is also O(N), but should have a worse constant
  because of the linked-list structure suffering much more from
  memory latency.

- Why does `igc_add_marker` take as much time as `igc_remove_marker`?
  `igc_add_marker` only needs to find an empty spot (whereas
  `igc_remove_marker` needs to find the one and only spot that holds
  the marker), so while it's also O(N) in the worst case, it should be
  faster on average.

[ FWIW, I'm incidentally playing with an implementation of the "set of
  markers" as an ordered array-with-gap, so bytes<->chars conversions
  take O(log N) time for N markers, because we can use binary search.
  Removal and addition of a marker can also use the binary search to
  find the spot, tho it's still O(N) overall because of the need to move
  the gap, but hopefully the gap is usually nearby already (and the
  constant is much smaller because it's just a `memmove`).
  Mostly fighting with the pdumper now.  ]


        Stefan

Re: MPS: dangling markers

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>>     36.34%  emacs         emacs                                          [.] igc_remove_marker
>>>     35.77%  emacs         emacs                                          [.] igc_add_marker
>
> I don't understand this:
>
> - Why is `igc_remove_marker` slower than `unchain_marker`?
>   `unchain_marker` is also O(N), but should have a worse constant
>   because of the linked-list structure suffering much more from
>   memory latency.
>
> - Why does `igc_add_marker` take as much time as `igc_remove_marker`?
>   `igc_add_marker` only needs to find an empty spot (whereas
>   `igc_remove_marker` needs to find the one and only spot that holds
>   the marker), so while it's also O(N) in the worst case, it should be
>   faster on average.

Yes, that doesn't make much sense to me either. add_marker even includes
allacaton/re-allocation costs.

Can it be that remove_marker is called much more often than add_marker?
@Ihor, do can see call counts?

  void
  igc_add_marker (struct buffer *b, struct Lisp_Marker *m)
  {
    Lisp_Object v = BUF_MARKERS (b);
    if (NILP (v))
      v = BUF_MARKERS (b) = alloc_vector_weak (1, Qnil);

    ptrdiff_t i = find_nil_index (v);
    if (i == ASIZE (v))
      v = BUF_MARKERS (b) = larger_vector_weak (v);
    Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
    ASET (v, i, marker);
  }

  void
  igc_remove_marker (struct buffer *b, struct Lisp_Marker *m)
  {
    m->buffer = NULL;
    Lisp_Object v = BUF_MARKERS (b);
    igc_assert (VECTORP (v));
    Lisp_Object marker = make_lisp_ptr (m, Lisp_Vectorlike);
    for (ptrdiff_t i = 0; i < ASIZE (v); ++i)
      if (EQ (AREF (v, i), marker))
        {
          ASET (v, i, Qnil);
          break;
        }
  }

> [ FWIW, I'm incidentally playing with an implementation of the "set of
>   markers" as an ordered array-with-gap, so bytes<->chars conversions
>   take O(log N) time for N markers, because we can use binary search.
>   Removal and addition of a marker can also use the binary search to
>   find the spot, tho it's still O(N) overall because of the need to move
>   the gap, but hopefully the gap is usually nearby already (and the
>   constant is much smaller because it's just a `memmove`).
>   Mostly fighting with the pdumper now.  ]

Hey, that's really really good! :-)

Re: MPS: dangling markers

[Stefan Monnier]

> Can it be that `remove_marker` is called much more often than add_marker?

I don't think you can remove a marker before having added it, so it
seems rather unlikely.

>   igc_add_marker (struct buffer *b, struct Lisp_Marker *m)
>   {
>     Lisp_Object v = BUF_MARKERS (b);
>     if (NILP (v))
>       v = BUF_MARKERS (b) = alloc_vector_weak (1, Qnil);
>
>     ptrdiff_t i = find_nil_index (v);

My guess is that `find_nil_index` almost always scans the buffer until
near the end.  It should be fairly easy to speed that up by keeping
a "pointer" to the last known empty slot, or use the empty slots to
"point to each other" to form a free-list.

Still doesn't explain why `remove_marker` takes more time on your branch
than on `master`, unless we end up keeping significantly larger vectors
than the length of the linked-lists used on `master`.

Maybe it's because `unchain_marker` often exits early (e.g. maybe it's
common that `unchain_marker` is used to delete a marker recently added,
so it's near the top of the linked list which ends up behaving a bit
like a stack)?


        Stefan

Re: MPS: dangling markers

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> Can it be that `remove_marker` is called much more often than add_marker?
>
> I don't think you can remove a marker before having added it, so it
> seems rather unlikely.
>
>>   igc_add_marker (struct buffer *b, struct Lisp_Marker *m)
>>   {
>>     Lisp_Object v = BUF_MARKERS (b);
>>     if (NILP (v))
>>       v = BUF_MARKERS (b) = alloc_vector_weak (1, Qnil);
>>
>>     ptrdiff_t i = find_nil_index (v);
>
> My guess is that `find_nil_index` almost always scans the buffer until
> near the end.  It should be fairly easy to speed that up by keeping
> a "pointer" to the last known empty slot, or use the empty slots to
> "point to each other" to form a free-list.

That could be an idea, indeed.

>
> Still doesn't explain why `remove_marker` takes more time on your branch
> than on `master`, unless we end up keeping significantly larger vectors
> than the length of the linked-lists used on `master`.
>
> Maybe it's because `unchain_marker` often exits early (e.g. maybe it's
> common that `unchain_marker` is used to delete a marker recently added,
> so it's near the top of the linked list which ends up behaving a bit
> like a stack)?

And that makes sense. I'll try tomorrow to add something to igc that
Ihor can tell us how many markers there are that are allocated in the
place Eli showed.

Re: MPS: dangling markers

[Gerd Möllmann]

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

> And that makes sense. I'll try tomorrow to add something to igc that
> Ihor can tell us how many markers there are that are allocated in the
> place Eli showed.

Can't sleep (football), so:

I ended up adding an integer parameter to build_marker, which is
different for each call site, because the markers built in marker.c
which Eli pointed to were not the problem, at least for what I did.

I start Emacs, M-x igc-stats which let's me see the number of markers.
Then repeated g to see the number of markers go up. What I see is a
rapid growth in markers, by the hundreds each time I refresh, and the
histogram looks like this

  [0 12 3039 0 8 9 19 0 0 0 47365 8 13 0 0 0 0 0 0 0 2618 2618 0 0 0 0 0
   0 0 0]

And 10 is

  DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
         doc: /* Return value of point, as a marker object.  */)
    (void)
  {
    return build_marker (current_buffer, PT, PT_BYTE, 10);
  }

Don't know who calls that, but it absolutely dominates.

Re: MPS: dangling markers

[Gerd Möllmann]

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

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> And that makes sense. I'll try tomorrow to add something to igc that
>> Ihor can tell us how many markers there are that are allocated in the
>> place Eli showed.
>
> Can't sleep (football), so:
>
> I ended up adding an integer parameter to build_marker, which is
> different for each call site, because the markers built in marker.c
> which Eli pointed to were not the problem, at least for what I did.
>
> I start Emacs, M-x igc-stats which let's me see the number of markers.
> Then repeated g to see the number of markers go up. What I see is a
> rapid growth in markers, by the hundreds each time I refresh, and the
> histogram looks like this
>
>   [0 12 3039 0 8 9 19 0 0 0 47365 8 13 0 0 0 0 0 0 0 2618 2618 0 0 0 0 0
>    0 0 0]
>
> And 10 is
>
>   DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
>          doc: /* Return value of point, as a marker object.  */)
>     (void)
>   {
>     return build_marker (current_buffer, PT, PT_BYTE, 10);
>   }
>
> Don't know who calls that, but it absolutely dominates.

Pushed to scratch/igc. Use build-marker-counts to get the numbers.

Re: MPS: dangling markers

[Gerd Möllmann]

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

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>> And that makes sense. I'll try tomorrow to add something to igc that
>>> Ihor can tell us how many markers there are that are allocated in the
>>> place Eli showed.
>>
>> Can't sleep (football), so:
>>
>> I ended up adding an integer parameter to build_marker, which is
>> different for each call site, because the markers built in marker.c
>> which Eli pointed to were not the problem, at least for what I did.
>>
>> I start Emacs, M-x igc-stats which let's me see the number of markers.
>> Then repeated g to see the number of markers go up. What I see is a
>> rapid growth in markers, by the hundreds each time I refresh, and the
>> histogram looks like this
>>
>>   [0 12 3039 0 8 9 19 0 0 0 47365 8 13 0 0 0 0 0 0 0 2618 2618 0 0 0 0 0
>>    0 0 0]
>>
>> And 10 is
>>
>>   DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
>>          doc: /* Return value of point, as a marker object.  */)
>>     (void)
>>   {
>>     return build_marker (current_buffer, PT, PT_BYTE, 10);
>>   }
>>
>> Don't know who calls that, but it absolutely dominates.
>
> Pushed to scratch/igc. Use build-marker-counts to get the numbers.

I think I have an idea: What if igc_add_marker records in Lisp_Marker at
which index in the weak vector it stored the marker? That would make
igc_remove_marker O(1).

Re: MPS: dangling markers

[Gerd Möllmann]

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

> I think I have an idea: What if igc_add_marker records in Lisp_Marker at
> which index in the weak vector it stored the marker? That would make
> igc_remove_marker O(1).

Pushed that to scratch/igc.

Ihor, could please measure again?

Next idea would be to make igc_add_marker O(1) with a free-list like
hash tables have in the next array. But let's first see if the above
change brings something to the table.

Re: MPS: dangling markers

[Ihor Radchenko]

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

> Pushed that to scratch/igc.

Thanks!

> Ihor, could please measure again?

A bit later today. I still need my Emacs working reliably to finish
other work :)

> Next idea would be to make igc_add_marker O(1) with a free-list like
> hash tables have in the next array. But let's first see if the above
> change brings something to the table.

Another idea is to do something akin what is being done for bignum
allocation - cache the last know free position in the vector.
See https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=091b8de586efc41c3dbd8606445c99c541e90076

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

>> Next idea would be to make igc_add_marker O(1) with a free-list like
>> hash tables have in the next array. But let's first see if the above
>> change brings something to the table.
>
> Another idea is to do something akin what is being done for bignum
> allocation - cache the last know free position in the vector.
> See https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=091b8de586efc41c3dbd8606445c99c541e90076

Thanks.

I think with an O(1) add_marker + O(1) remove_marker it could be that we
are already good. At least I get that impression from the percentages
both functions took in your measurement. The O(1) remove we have. The
O(1) add is no magic either - I just make the same mistakes as when
implementing hash tables for 21, then remove the mistakes, and voila
:-). I'll give a shot later.

Re: MPS: dangling markers

[Ihor Radchenko]

Ihor Radchenko <yantar92@posteo.net> writes:

>> Ihor, could please measure again?

The latest scratch/igc does not compile because of dc3e5cbe5b6.

textconv.c: In function ‘record_buffer_change’:
textconv.c:480:16: error: too few arguments to function ‘build_marker’
  480 |   beg_marker = build_marker (current_buffer, beg,
      |                ^~~~~~~~~~~~
In file included from textconv.h:22,
                 from textconv.c:35:
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~
textconv.c:490:20: error: too few arguments to function ‘build_marker’
  490 |       end_marker = build_marker (current_buffer, end,
      |                    ^~~~~~~~~~~~
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~
textconv.c: In function ‘really_set_composing_text’:
textconv.c:871:11: error: too few arguments to function ‘build_marker’
  871 |         = build_marker (current_buffer, PT, PT_BYTE);
      |           ^~~~~~~~~~~~
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~
textconv.c:873:11: error: too few arguments to function ‘build_marker’
  873 |         = build_marker (current_buffer, PT, PT_BYTE);
      |           ^~~~~~~~~~~~
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~
textconv.c: In function ‘locate_and_save_position_in_field’:
textconv.c:1168:12: error: too few arguments to function ‘build_marker’
 1168 |       c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg));
      |            ^~~~~~~~~~~~
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~
textconv.c:1169:12: error: too few arguments to function ‘build_marker’
 1169 |       c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end));
      |            ^~~~~~~~~~~~
lisp.h:5155:20: note: declared here
 5155 | extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
      |                    ^~~~~~~~~~~~

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Ihor Radchenko <yantar92@posteo.net> writes:
>
>>> Ihor, could please measure again?
>
> The latest scratch/igc does not compile because of dc3e5cbe5b6.
>
> textconv.c: In function ‘record_buffer_change’:
> textconv.c:480:16: error: too few arguments to function ‘build_marker’
>   480 |   beg_marker = build_marker (current_buffer, beg,
>       |                ^~~~~~~~~~~~

Can someone on a Linux help? That's a part that is not used on
macOS.

Ihor, you could also try to revert dc3e5cbe5b65278bd977c86f347df748823712a7,

Re: MPS: dangling markers

[Ihor Radchenko]

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

>> The latest scratch/igc does not compile because of dc3e5cbe5b6.
>>
>> textconv.c: In function ‘record_buffer_change’:
>> textconv.c:480:16: error: too few arguments to function ‘build_marker’
>>   480 |   beg_marker = build_marker (current_buffer, beg,
>>       |                ^~~~~~~~~~~~
>
> Can someone on a Linux help? That's a part that is not used on
> macOS.

Fixing should be just a matter of passing that extra int argument in
really all places.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>>> The latest scratch/igc does not compile because of dc3e5cbe5b6.
>>>
>>> textconv.c: In function ‘record_buffer_change’:
>>> textconv.c:480:16: error: too few arguments to function ‘build_marker’
>>>   480 |   beg_marker = build_marker (current_buffer, beg,
>>>       |                ^~~~~~~~~~~~
>>
>> Can someone on a Linux help? That's a part that is not used on
>> macOS.
>
> Fixing should be just a matter of passing that extra int argument in
> really all places.

I've reverted it, so it should work now.

Re: MPS: dangling markers

[Ihor Radchenko]

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

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

>> Fixing should be just a matter of passing that extra int argument in
>> really all places.
>
> I've reverted it, so it should work now.

Or you can use the attached patch on top of the original commit.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-all-the-calls-to-build_marker-after-dc3e5cbe5b6.patch --]
[-- Type: text/x-patch, Size: 2162 bytes --]

From 972c6c6652b49302ae6ea2fc77c59d998b547fd3 Mon Sep 17 00:00:00 2001
Message-ID: <972c6c6652b49302ae6ea2fc77c59d998b547fd3.1719749890.git.yantar92@posteo.net>
From: Ihor Radchenko <yantar92@posteo.net>
Date: Sun, 30 Jun 2024 14:17:50 +0200
Subject: [PATCH] Fix all the calls to `build_marker' after dc3e5cbe5b6

---
 src/textconv.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/textconv.c b/src/textconv.c
index 0e43bd9d458..a601dcd6729 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -478,7 +478,7 @@ record_buffer_change (ptrdiff_t beg, ptrdiff_t end,
 
   /* Make markers for both BEG and END.  */
   beg_marker = build_marker (current_buffer, beg,
-			     CHAR_TO_BYTE (beg));
+			     CHAR_TO_BYTE (beg), 22);
 
   /* If BEG and END are identical, make sure to keep the markers
      eq.  */
@@ -488,7 +488,7 @@ record_buffer_change (ptrdiff_t beg, ptrdiff_t end,
   else
     {
       end_marker = build_marker (current_buffer, end,
-				 CHAR_TO_BYTE (end));
+				 CHAR_TO_BYTE (end), 23);
 
       /* Otherwise, make sure the marker extends past inserted
 	 text.  */
@@ -868,9 +868,9 @@ really_set_composing_text (struct frame *f, ptrdiff_t position,
 
       /* Now set the markers which denote the composition region.  */
       f->conversion.compose_region_start
-	= build_marker (current_buffer, PT, PT_BYTE);
+	= build_marker (current_buffer, PT, PT_BYTE, 24);
       f->conversion.compose_region_end
-	= build_marker (current_buffer, PT, PT_BYTE);
+	= build_marker (current_buffer, PT, PT_BYTE, 24);
 
       Fset_marker_insertion_type (f->conversion.compose_region_end,
 				  Qt);
@@ -1165,8 +1165,8 @@ locate_and_save_position_in_field (struct frame *f, struct window *w,
     }
   else
     {
-      c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg));
-      c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end));
+      c1 = build_marker (current_buffer, beg, CHAR_TO_BYTE (beg), 25);
+      c2 = build_marker (current_buffer, end, CHAR_TO_BYTE (end), 25);
       Fset_marker_insertion_type (c2, Qt);
       f->conversion.field = Fcons (c1, Fcons (c2, window));
     }
-- 
2.45.2


[-- Attachment #3: Type: text/plain, Size: 225 bytes --]



-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Ihor Radchenko]

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

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> I think I have an idea: What if igc_add_marker records in Lisp_Marker at
>> which index in the weak vector it stored the marker? That would make
>> igc_remove_marker O(1).
>
> Pushed that to scratch/igc.
>
> Ihor, could please measure again?

As expected, igc_remove_marker disappeared. igc_add_marker is still there.

    33.12%  emacs            emacs                                          [.] igc_add_marker
     7.31%  emacs            emacs                                          [.] exec_byte_code
     5.24%  emacs            emacs                                          [.] re_search_2
     4.39%  emacs            emacs                                          [.] Fmemq
     3.85%  emacs            emacs                                          [.] re_match_2_internal
     3.07%  emacs            emacs                                          [.] funcall_subr
     2.74%  emacs            emacs                                          [.] buf_bytepos_to_charpos
     2.65%  emacs            emacs                                          [.] buf_charpos_to_bytepos
     2.38%  emacs            emacs                                          [.] Ffuncall
     1.68%  emacs            emacs                                          [.] funcall_general
     1.08%  emacs            emacs                                          [.] plist_get
     1.04%  emacs            emacs                                          [.] alloc_impl

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>> I think I have an idea: What if igc_add_marker records in Lisp_Marker at
>>> which index in the weak vector it stored the marker? That would make
>>> igc_remove_marker O(1).
>>
>> Pushed that to scratch/igc.
>>
>> Ihor, could please measure again?
>
> As expected, igc_remove_marker disappeared. igc_add_marker is still there.
>
>     33.12%  emacs            emacs                                          [.] igc_add_marker

Thanks, Ihor, that looks promising. I've now also pushed a quick and
dirty add_marker in O(1), that's why I reverted. to get that on top.
Works for me...

A comparison of how it feels compared to master would also be interesting.

Re: MPS: dangling markers

[Ihor Radchenko]

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

> Thanks, Ihor, that looks promising. I've now also pushed a quick and
> dirty add_marker in O(1), that's why I reverted. to get that on top.
> Works for me...
>
> A comparison of how it feels compared to master would also be interesting.

igc.c: In function ‘fix_marker_vector’:
igc.c:1701:34: error: passing argument 1 of ‘NILP’ makes pointer from integer without a cast [-Wint-conversion]
 1701 |         if (NILP (v->contents[i] && !NILP (old)))
      |                   ~~~~~~~~~~~~~~~^~~~~~~~~~~~~~
      |                                  |
      |                                  int
In file included from igc.c:31:
lisp.h:1499:21: note: expected ‘Lisp_Object’ {aka ‘struct Lisp_X *’} but argument is of type ‘int’
 1499 | (NILP) (Lisp_Object x)
      |         ~~~~~~~~~~~~^

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Thanks, Ihor, that looks promising. I've now also pushed a quick and
>> dirty add_marker in O(1), that's why I reverted. to get that on top.
>> Works for me...
>>
>> A comparison of how it feels compared to master would also be interesting.
>
> igc.c: In function ‘fix_marker_vector’:
> igc.c:1701:34: error: passing argument 1 of ‘NILP’ makes pointer from integer without a cast [-Wint-conversion]
>  1701 |         if (NILP (v->contents[i] && !NILP (old)))
>       |                   ~~~~~~~~~~~~~~~^~~~~~~~~~~~~~
>       |                                  |
>       |                                  int
> In file included from igc.c:31:
> lisp.h:1499:21: note: expected ‘Lisp_Object’ {aka ‘struct Lisp_X *’} but argument is of type ‘int’
>  1499 | (NILP) (Lisp_Object x)
>       |         ~~~~~~~~~~~~^

Soory, either I've fat-fingered something, or clang 15 is a bit too
permissive :-(

Psuhed a fix.

Re: MPS: dangling markers

[Ihor Radchenko]

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

> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>
>>> Thanks, Ihor, that looks promising. I've now also pushed a quick and
>>> dirty add_marker in O(1), that's why I reverted. to get that on top.
>>> Works for me...

I no longer see markers in the perf stats.

>>> A comparison of how it feels compared to master would also be interesting.

Still crashing :) (mostly because of child process signal - it
constantly triggers when running background compilation via staight.el)

Otherwise, things are snappy. At least on par with master (to open my
agenda, in terms of CPU samples recorded by perf), if not faster. (but I
had to remove all the debug info from the build and not run gdb to get
that "on par")

Also, doing LD_PRELOAD=/usr/lib64/libjemalloc.so.2 is a bad idea with
scratch/igc. Not that it made things crash, but it made things slower.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>
>> Ihor Radchenko <yantar92@posteo.net> writes:
>>
>>> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
>>>
>>>> Thanks, Ihor, that looks promising. I've now also pushed a quick and
>>>> dirty add_marker in O(1), that's why I reverted. to get that on top.
>>>> Works for me...
>
> I no longer see markers in the perf stats.

Very good. Thanks for testing, Ihor!

>>>> A comparison of how it feels compared to master would also be interesting.
>
> Still crashing :) (mostly because of child process signal - it
> constantly triggers when running background compilation via staight.el)
>
> Otherwise, things are snappy. At least on par with master (to open my
> agenda, in terms of CPU samples recorded by perf), if not faster. (but I
> had to remove all the debug info from the build and not run gdb to get
> that "on par")

Thanks, that sounds good. I guess I'll consider the marker stuff done
for now. The code could need some clean up though.

Re: MPS: dangling markers

[Eli Zaretskii]

> From: Ihor Radchenko <yantar92@posteo.net>
> Cc: Stefan Monnier <monnier@iro.umontreal.ca>, emacs-devel@gnu.org, Eli
>  Zaretskii <eliz@gnu.org>, eller.helmut@gmail.com
> Date: Sun, 30 Jun 2024 12:38:24 +0000
> 
> Gerd Möllmann <gerd.moellmann@gmail.com> writes:
> 
> > Thanks, Ihor, that looks promising. I've now also pushed a quick and
> > dirty add_marker in O(1), that's why I reverted. to get that on top.
> > Works for me...
> >
> > A comparison of how it feels compared to master would also be interesting.
> 
> igc.c: In function ‘fix_marker_vector’:
> igc.c:1701:34: error: passing argument 1 of ‘NILP’ makes pointer from integer without a cast [-Wint-conversion]
>  1701 |         if (NILP (v->contents[i] && !NILP (old)))
>       |                   ~~~~~~~~~~~~~~~^~~~~~~~~~~~~~
>       |                                  |
>       |                                  int
> In file included from igc.c:31:
> lisp.h:1499:21: note: expected ‘Lisp_Object’ {aka ‘struct Lisp_X *’} but argument is of type ‘int’
>  1499 | (NILP) (Lisp_Object x)
>       |         ~~~~~~~~~~~~^

I think I fixed that.

Re: MPS: dangling markers

[Ihor Radchenko]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> - perf points to (1) itree lookup; (2) bytepos<->charpos, which implies
>>   that things may be related to the number of allocated markers and
>>   overlays...
> ...
> So I'm not surprised by your point (2) above, but I don't have an
> explanation for your point (1), OTOH.

(1) was a false alarm (kind of). The perf recording was for redisplay
that did a lot of text property searches. These searches were iterating
over the overlays as well, but it had nothing to do with scratch/igc
branch; just a normal (slow) redisplay behavior when there are large
chunks of hidden text. It's just that igc fiddling with markers made the
performance completely unbearable.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: MPS: dangling markers

[Gerd Möllmann]

Ihor Radchenko <yantar92@posteo.net> writes:

> Related: bug#71644, bug#63040
>
> When running the scratch/igc branch, I noticed a severe slowdown (10x or
> more) of redisplay on my large Org buffers.
>
> - The redisplay manifests itself as I build agenda multiple times
>   (agenda creates many new markers).
>
> - perf points to (1) itree lookup; (2) bytepos<->charpos, which implies
>   that things may be related to the number of allocated markers and
>   overlays.
>
> - I observe things slowing down as the number of "PVEC_MARKER" in the
>   output of `igc-info' grows.
>
> - Forcing (igc--collect) returns speed to normal

Ok, interesting.

> I believe that my observation reveals one important point that may need
> to be considered when using MPS:
>
> We may need to more careful about cases in Emacs C code that traverse
> object lists that may contain unreferenced objects.  Because MPS does
> not perform GC as regularly as the traditional mark-and-sweep, some
> unreferenced objects may remain live and present in internal data
> structures for a long time.

Maybe it's helpful when I describe what I do for the buffer markers, as
opposed to what is done currently.

In master, buffer_text::markers is a singly-linked list of Lisp_Markers,
using Lisp_Marker::next. In the sweep phase of GC, in sweeo_buffers, we
iterate over all buffers and remove markers from the list that were not
marked during the mark phase of GC. The list itself is left alone in the
mark phase, so that references from these lists don't keep markers
alive. The buffer markers thus acts as a weak list. Since
garbage_collect is called often enough, markers are swiftly remnoved
from the marker lists.

What I've done in igc so far: buffer_text::markers is a Lisp vector and
Lisp_Marker::next is gone. Elements of the vector are either nil or a
marker. The vector is weak, entries for markers that are not referenced
from somewhere else are set to nil eventually. Adding and removing
markers is done naively in O(N) where N is the size of the vector. The
vectors are resized if needed by doubling their size. They are never
shrunk. Iteration goes over the whole vector, ignoring nil entries.

Possibly, there is some potential for improvement :-).

What we can't do is hope to make this weakness more "eager" so to say.
Entries in weak vectors are reset to nil, but when MPS thinks it's a
good time doing that. (It's BTW the wrong mental model to think of MPS
doing GC at a specific time. It's more like doing GC work all the time,
concurrently.) But it's true that MPS doesn't "eagerly" reset entries in
these vectors. And there's no way, to my knowledge, to force it to do
that other than to trigger a full GC.

Ideas welcome, or better yet implemenations :-). I'm currently not
working on this.

> AFAIK, at least overlays, buffers, and markers are used in C code within
> object lists/trees are often traversed in full. If objects in these
> lists are not regularly garbage-collected, we may end up in situation
> when dead objects significantly impact performance. I believe that what
> I observe locally is exactly the described scenario.

Probably.