bug#36566: 27.0.50; debug is sometimes horribly slow

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Hi,

sometimes it takes 10 or 20 seconds until the debugger pops up.  I
debugged code using widgets (who are complicated long lists).  But both
the number of frames and the length of the printed lists were not
exorbitant - a quite normal situation.

When I revert

e09120d68694272ea5efbe13b16936b4382389d8
Add backtrace-mode and use it in the debugger, ERT and Edebug

the debugger becomes fast again and pops up in a reasonable time.  With
the commit, the debugger is quite unusable in some cases: stepping
(`debugger-step-through') takes ten seconds per hit etc.  Not good.

FWIW, I think I very much appreciate the cited commit - I didn't yet
make use of the added features but it seems to be cool.  I hope we can
find a solution here.  At least there should be a way to get a faster
behavior.  BTW, I used the profiler and found that most of the time is
spent while garbage collecting.  My first thought was that cl-print may
be the culprit but that doesn't seem to be the case.

TIA,

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Drew Adams]

> sometimes it takes 10 or 20 seconds until the debugger pops up.  I
> debugged code using widgets (who are complicated long lists).  But both
> the number of frames and the length of the printed lists were not
> exorbitant - a quite normal situation.
> 
> When I revert
> 
> e09120d68694272ea5efbe13b16936b4382389d8
> Add backtrace-mode and use it in the debugger, ERT and Edebug
> 
> the debugger becomes fast again and pops up in a reasonable time.  With
> the commit, the debugger is quite unusable in some cases: stepping
> (`debugger-step-through') takes ten seconds per hit etc.  Not good.
> 
> FWIW, I think I very much appreciate the cited commit - I didn't yet
> make use of the added features but it seems to be cool.  I hope we can
> find a solution here.  At least there should be a way to get a faster
> behavior.  BTW, I used the profiler and found that most of the time is
> spent while garbage collecting.  My first thought was that cl-print may
> be the culprit but that doesn't seem to be the case.

BTW:
Is there a way to "turn off" the feature introduced
by the commit, even if most people want it on most
of the time?  (I'm not familiar with the feature,
but it sounds like something some users might want
to turn off sometimes.)

bug#36566: 27.0.50; debug is sometimes horribly slow

[Noam Postavsky]

Michael Heerdegen <michael_heerdegen@web.de> writes:
>
> sometimes it takes 10 or 20 seconds until the debugger pops up.  I
> debugged code using widgets (who are complicated long lists).  But both
> the number of frames and the length of the printed lists were not
> exorbitant - a quite normal situation.

Can you give an example recipe that produces the slowness?  It's not
usually slow, right?  (When I trigger the debugger in master right now,
I don't notice problem.)

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

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

Noam Postavsky <npostavs@gmail.com> writes:

> > sometimes it takes 10 or 20 seconds until the debugger pops up.  I
> > debugged code using widgets (who are complicated long lists).  But both
> > the number of frames and the length of the printed lists were not
> > exorbitant - a quite normal situation.
>
> Can you give an example recipe that produces the slowness?  It's not
> usually slow, right?  (When I trigger the debugger in master right now,
> I don't notice problem.)

I investigated a bit and found that the main factor of the sluggishness
seems to be my private (global) setting of print-gensym -> t: I can
toggle sluggishness in both the Emacs with my setup and emacs -Q just by
toggling this variable.  My debugger use case involves gensyms (see
later).  Ok, so it's probably mainly a printing issue.

Here is my use case: load the attached file (don't compile, I made it
contain a bug).  M-x find-cmd-widget, and insert a "links" expression
by hitting the INS button and select "links" with the "expr" button.

With print-gemsym -> nil, the debugger needs approx. 2 seconds here to
pop up, and with print-gemsym -> t, approx. 12.  So I wonder why this
setting makes it that slow - I would expect a small time penalty, but
such a big difference?

BTW, extra points if the debugger provided commands/ a menu to tune such
settings (like printing variables) live when using it.


[-- Attachment #2: find-cmd-widget.el --]
[-- Type: application/emacs-lisp, Size: 25662 bytes --]

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



Thanks,

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> With print-gemsym -> nil, the debugger needs approx. 2 seconds here to
> pop up, and with print-gemsym -> t, approx. 12.  So I wonder why this
> setting makes it that slow - I would expect a small time penalty, but
> such a big difference?

The C printing code builds hash tables to match gensyms to the numbers
they are printed with.  So it is building and discarding these hash
tables which causes the garbage collection and the slowdown.  Emacs 26's
backtrace printing is also significantly slower with print-gensym turned
on.

The reason master is so much slower than Emacs 26 is because of the
adaptive abbreviating I added to reduce problems with really long lines.
In Emacs 26 it's hard to debug things like magit or org-mode because
lines in the backtrace can easily get to be thousands or millions of
characters long and display gets really slow.  When I added
backtrace-mode, I gave it a target line length and a function which
starts with guesses at the appropriate values of print-length and
print-level, and which iteratively prints using those values, and if the
length of the printed representation is over the target, it reduces
print-length and print-level and tries again.  That reprinting, and
consequential repeated construction of gensym hash tables, is what's
making master slower than Emacs 26 in this case.

I remember when I was writing that function thinking that it was a
heuristic sort of algorithm and would likely need tweaking, so here we
are.

The easy fix for you for today is to set backtrace-line-length to 100 or
less, which will make the initial values of print-length and print-level
so low that little reprinting will be done.  Then use
backtrace-expand-ellipsis (bound to "."), with or without C-u, on the
lines where you want to see the full data structure.  And try "+" and
"-" if you haven't already.

I'll experiment with tweaking the heuristic to reduce the amount of
reprinting it does, and let you know what I come up with.

> BTW, extra points if the debugger provided commands/ a menu to tune such
> settings (like printing variables) live when using it.

There is such a command for print-circle (bound to "#") and it would be
easy to add one for print-gensym, although I could use a keybinding
suggestion.  backtrace-line-length is a defcustom.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Gemini Lasswell <gazally@runbox.com> writes:

> The easy fix for you for today is to set backtrace-line-length to 100 or
> less, which will make the initial values of print-length and print-level
> so low that little reprinting will be done.  Then use
> backtrace-expand-ellipsis (bound to "."), with or without C-u, on the
> lines where you want to see the full data structure.  And try "+" and
> "-" if you haven't already.

Ok, will have a look at these commands.  I've simply turned print-gensym
off for now in the debugger.


> I'll experiment with tweaking the heuristic to reduce the amount of
> reprinting it does, and let you know what I come up with.

Ok, great, tia.  Dunno if it would be worth it to optimize this test
printing, e.g. by turning print-gensym temporarily off.

> > BTW, extra points if the debugger provided commands/ a menu to tune such
> > settings (like printing variables) live when using it.
>
> There is such a command for print-circle (bound to "#") and it would be
> easy to add one for print-gensym, although I could use a keybinding
> suggestion.

You could use ":".  Or "# #" for print-circle and "# :" for print-gensym
(i.e. make "#" a prefix command).  This is inspired by print-circle
references looking like #N# and print syntax of gensyms looking like
#:NAME.

In any case, _please_ add both to the menu for discoverability, maybe
also the "global" version (i.e. 4 entries in sum).


BTW, when I eval this

(let ((x '#1=(1 . #1#)))
  (debug)
  (cons x x))

I get a backtrace like

Debugger entered: nil
  (let ((x '(1 . #6))) (debug) (cons x x))
  eval((let ((x '(1 . #7))) (debug) (cons x x)) t)

whereby when I hit C-u # all references get number 1, or start from 1
for every frame:

Debugger entered: nil
  (let ((x '#1=(1 . #1#))) (debug) (cons x x))
  eval((let ((x '#1=(1 . #1#))) (debug) (cons x x)) t)

Just a minor inconvenience, though.

Anyway, thanks for improving the debugger in this way so far, this is
very useful.


Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> BTW, when I eval this
>
> (let ((x '#1=(1 . #1#)))
>   (debug)
>   (cons x x))
>
> I get a backtrace like
>
> Debugger entered: nil
>   (let ((x '(1 . #6))) (debug) (cons x x))
>   eval((let ((x '(1 . #7))) (debug) (cons x x)) t)
>
> whereby when I hit C-u # all references get number 1, or start from 1
> for every frame:
>
> Debugger entered: nil
>   (let ((x '#1=(1 . #1#))) (debug) (cons x x))
>   eval((let ((x '#1=(1 . #1#))) (debug) (cons x x)) t)
>
> Just a minor inconvenience, though.

Without print-circle turned on, no hash table gets built to identify
objects, so the #<number> is only an indicator that a loop was found in
the data structure, not an indicator of any particular object. The
number printed comes from the depth of nested data structures at the
point the loop is detected.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

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

Gemini Lasswell <gazally@runbox.com> writes:

> The reason master is so much slower than Emacs 26 is because of the
> adaptive abbreviating I added to reduce problems with really long lines.

That statement turned out to be true, however once I improved the
adaptive abbreviating algorithm it became apparent to me that backtrace
printing was creating an excessive amount of garbage in both Emacs 26
and 27 when either print-circle or print-gensym was set.

As part of my investigating process I made a patch which added a
hash-tables-consed variable along the lines of strings-consed et al,
which I incremented in Fmake_hash_table to count the number of hash
tables created, and got the following interesting result:

(let ((print-gensym t))
  (list hash-tables-consed (princ "hello") hash-tables-consed))
=>
hello
(814064 "hello" 814065)

This is relevant to backtrace printing because backtrace printing uses
cl-prin1, which prints Lisp data structures using

(princ "(" stream)

to print the parentheses, which was making for a lot of created and
destroyed hash tables whenever print-circle or print-gensym was set.

The third patch attached below fixes that by adding a macro to
cl-print.el to wrap the printing of all the simple things with
let-bindings of print-circle and print-gensym to nil.

Patch #2 improves cl-print-to-string-with-limit's adaptive fitting of a
printed representation into a given line length by making it reduce
print-level and print-length more rapidly when the result of a test
printing is very long.

Patch #1 improves the backtrace-mode UI by adding a command to toggle
print-gensym, and puts both that and its print-circle toggle command on
the menu, and adds an echo area message to both to let you know what
they did.

Here's how long Michael's use case takes to render the backtrace
buffer on my machine, with print-gensym non-nil, in various versions of
Emacs:

Emacs 26.2: 4.1s
Emacs 27, before patches: 9.4s
Emacs 27, with patch #2: 5.6s
Emacs 27, with patches #2 and #3: 1.2s.

Patch #3 has the advantage of being straightforward logically and not
breaking anything which doesn't use cl-prin1, but it undoubtedly also
slows down cl-prin1 in the probably more common case that print-gensym
and print-circle are both nil.  There are other ways to fix this, such
as by adding a new entry point in print.c for printing simple strings,
or by modifying the logic in print_preprocess to not create a hash table
if the top-level object is a string with no properties.  I'm not sure
what the best choice is here, so let me know what you think.


[-- Attachment #2: Patch #1 --]
[-- Type: text/plain, Size: 9239 bytes --]

From 12c28d02ee7dc34133f5cd1352d6d65f86509bb7 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 30 Jul 2019 10:00:27 -0700
Subject: [PATCH 1/3] Improve print output options commands in backtrace-mode
 (bug#36566)

* lisp/emacs-lisp/backtrace.el (backtrace-view): Mention
:print-gensym in docstring.
(backtrace-mode-map): Add keyboard binding for
backtrace-toggle-print-gensym.  Add menu entries for
backtrace-toggle-print-circle and backtrace-toggle-print-gensym.
(backtrace--with-output-variables): Bind print-gensym with value
of :print-gensym found in view plist.
(backtrace-toggle-print-circle): Remove description of
implementation details from docstring.
(backtrace-toggle-print-gensym): New command.
(backtrace--toggle-feature): Add echo area message describing result
of command.

* test/lisp/emacs-lisp/backtrace-tests.el
(backtrace-tests--print-circle): New test.

* doc/lispref/debugging.texi (Backtraces): Document keyboard
binding for backtrace-toggle-print-gensym.
---
 doc/lispref/debugging.texi              |  3 ++
 lisp/emacs-lisp/backtrace.el            | 44 +++++++++++++++++-----
 test/lisp/emacs-lisp/backtrace-tests.el | 49 +++++++++++++++++++++++++
 3 files changed, 86 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 9e43343310..5393b2766a 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -457,6 +457,9 @@ Backtraces
 @item #
 Toggle @code{print-circle} for the frame at point.
 
+@item :
+Toggle @code{print-gensym} for the frame at point.
+
 @item .
 Expand all the forms abbreviated with ``...'' in the frame at point.
 
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 60d146e24a..0c4c7987c3 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -175,7 +175,8 @@ backtrace-frames
 
 (defvar-local backtrace-view nil
   "A plist describing how to render backtrace frames.
-Possible entries are :show-flags, :show-locals and :print-circle.")
+Possible entries are :show-flags, :show-locals, :print-circle
+and :print-gensym.")
 
 (defvar-local backtrace-insert-header-function nil
   "Function for inserting a header for the current Backtrace buffer.
@@ -205,6 +206,7 @@ backtrace-mode-map
     (define-key map "p" 'backtrace-backward-frame)
     (define-key map "v" 'backtrace-toggle-locals)
     (define-key map "#" 'backtrace-toggle-print-circle)
+    (define-key map ":" 'backtrace-toggle-print-gensym)
     (define-key map "s" 'backtrace-goto-source)
     (define-key map "\C-m" 'backtrace-help-follow-symbol)
     (define-key map "+" 'backtrace-multi-line)
@@ -224,6 +226,18 @@ backtrace-mode-map
          :active (backtrace-get-index)
          :selected (plist-get (backtrace-get-view) :show-locals)
          :help "Show or hide the local variables for the frame at point"]
+        ["Show Circular Structures" backtrace-toggle-print-circle
+         :style toggle
+         :active (backtrace-get-index)
+         :selected (plist-get (backtrace-get-view) :print-circle)
+         :help
+         "Condense or expand shared or circular structures in the frame at point"]
+        ["Show Uninterned Symbols" backtrace-toggle-print-gensym
+         :style toggle
+         :active (backtrace-get-index)
+         :selected (plist-get (backtrace-get-view) :print-gensym)
+         :help
+         "Toggle unique printing of uninterned symbols in the frame at point"]
         ["Expand \"...\"s" backtrace-expand-ellipses
          :help "Expand all the abbreviated forms in the current frame"]
         ["Show on Multiple Lines" backtrace-multi-line
@@ -339,6 +353,7 @@ backtrace--with-output-variables
   `(let ((print-escape-control-characters t)
          (print-escape-newlines t)
          (print-circle (plist-get ,view :print-circle))
+         (print-gensym (plist-get ,view :print-gensym))
          (standard-output (current-buffer)))
      ,@body))
 
@@ -420,12 +435,18 @@ backtrace--change-button-skip
 
 (defun backtrace-toggle-print-circle (&optional all)
   "Toggle `print-circle' for the backtrace frame at point.
-With prefix argument ALL, toggle the value of :print-circle in
-`backtrace-view', which affects all of the backtrace frames in
-the buffer."
+With prefix argument ALL, toggle the default value bound to
+`print-circle' for all the frames in the buffer."
   (interactive "P")
   (backtrace--toggle-feature :print-circle all))
 
+(defun backtrace-toggle-print-gensym (&optional all)
+  "Toggle `print-gensym' for the backtrace frame at point.
+With prefix argument ALL, toggle the default value bound to
+`print-gensym' for all the frames in the buffer."
+  (interactive "P")
+  (backtrace--toggle-feature :print-gensym all))
+
 (defun backtrace--toggle-feature (feature all)
   "Toggle FEATURE for the current backtrace frame or for the buffer.
 FEATURE should be one of the options in `backtrace-view'.  If ALL
@@ -450,12 +471,15 @@ backtrace--toggle-feature
           (goto-char (point-min))
           (while (and (not (eql index (backtrace-get-index)))
                       (< (point) (point-max)))
-            (goto-char (backtrace-get-frame-end)))))
-    (let ((index (backtrace-get-index)))
-      (unless index
-        (user-error "Not in a stack frame"))
-      (backtrace--set-feature feature
-                              (not (plist-get (backtrace-get-view) feature))))))
+            (goto-char (backtrace-get-frame-end))))
+        (message "%s is now %s for all frames"
+                 (substring (symbol-name feature) 1) value))
+    (unless (backtrace-get-index)
+      (user-error "Not in a stack frame"))
+    (let ((value (not (plist-get (backtrace-get-view) feature))))
+      (backtrace--set-feature feature value)
+      (message "%s is now %s for this frame"
+               (substring (symbol-name feature) 1) value))))
 
 (defun backtrace--set-feature (feature value)
   "Set FEATURE in the view plist of the frame at point to VALUE.
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index ce827e0166..be15495342 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -335,6 +335,55 @@ backtrace-tests--print-circle
       (should (string-match-p results
                               (backtrace-tests--get-substring (point-min) (point-max)))))))
 
+(ert-deftest backtrace-tests--print-gensym ()
+  "Backtrace buffers can toggle `print-gensym' syntax."
+  (ert-with-test-buffer (:name "print-gensym")
+    (let* ((print-gensym nil)
+           (arg (list (gensym "first") (gensym) (gensym "last")))
+           (results (backtrace-tests--make-regexp
+                     (backtrace-tests--result arg)))
+           (results-gensym (regexp-quote (let ((print-gensym t))
+                                           (backtrace-tests--result arg))))
+           (last-frame (backtrace-tests--make-regexp
+                        (format (nth (1- backtrace-tests--line-count)
+                                     (backtrace-tests--backtrace-lines))
+                                arg)))
+           (last-frame-gensym (regexp-quote
+                               (let ((print-gensym t))
+                                 (format (nth (1- backtrace-tests--line-count)
+                                              (backtrace-tests--backtrace-lines))
+                                         arg)))))
+      (backtrace-tests--make-backtrace arg)
+      (backtrace-print)
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Go to the last frame.
+      (goto-char (point-max))
+      (forward-line -1)
+      ;; Turn on print-gensym for that frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      ;; Turn off print-gensym for the frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym on for the buffer.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results-gensym
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym off.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring
+                               (point) (+ (point) (length last-frame)))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max)))))))
+
 (defun backtrace-tests--make-regexp (str)
   "Make regexp from STR for `backtrace-tests--print-circle'.
 Used for results of printing circular objects without
-- 
2.19.2


[-- Attachment #3: Patch #2 --]
[-- Type: text/plain, Size: 2227 bytes --]

From d1bc53f6e803336b279694c529bcaddd2bbb688f Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 30 Jul 2019 11:56:51 -0700
Subject: [PATCH 2/3] Improve performance of backtrace printing (bug#36566)

* lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
print-level and print-length more quickly when the structure being
printed is very large.
---
 lisp/emacs-lisp/cl-print.el | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5fe3dd1b91..530770128e 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -548,21 +548,22 @@ cl-print-to-string-with-limit
   ;; call_debugger (bug#31919).
   (let* ((print-length (when limit (min limit 50)))
          (print-level (when limit (min 8 (truncate (log limit)))))
-         (delta (when limit
-                  (max 1 (truncate (/ print-length print-level))))))
+         (delta-length (when limit
+                         (max 1 (truncate (/ print-length print-level))))))
     (with-temp-buffer
       (catch 'done
         (while t
           (erase-buffer)
           (funcall print-function value (current-buffer))
-          ;; Stop when either print-level is too low or the value is
-          ;; successfully printed in the space allowed.
-          (when (or (not limit)
-                    (< (- (point-max) (point-min)) limit)
-                    (= print-level 2))
-            (throw 'done (buffer-string)))
-          (cl-decf print-level)
-          (cl-decf print-length delta))))))
+          (let ((result (- (point-max) (point-min))))
+            ;; Stop when either print-level is too low or the value is
+            ;; successfully printed in the space allowed.
+            (when (or (not limit) (< result limit) (<= print-level 2))
+              (throw 'done (buffer-string)))
+            (let* ((ratio (/ result limit))
+                   (delta-level (max 1 (min (- print-level 2) ratio))))
+              (cl-decf print-level delta-level)
+              (cl-decf print-length (* delta-length delta-level)))))))))
 
 (provide 'cl-print)
 ;;; cl-print.el ends here
-- 
2.19.2


[-- Attachment #4: Patch #3 --]
[-- Type: text/plain, Size: 14526 bytes --]

From 5e62789a1b0c24560565312e220e0122d2f03ea3 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Wed, 31 Jul 2019 16:07:24 -0700
Subject: [PATCH 3/3] Fix excessive hash table creation in cl-prin1 (bug
 #36566)

Bind print-circle and print-gensym to nil when printing
simple objects, to prevent princ from creating unnecessary
hash tables.

* lisp/emacs-lisp/cl-print.el (cl--princ): New macro.
(cl-print-object, cl-print-object-contents): Use it.
---
 lisp/emacs-lisp/cl-print.el | 132 +++++++++++++++++++-----------------
 1 file changed, 70 insertions(+), 62 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 530770128e..aa9364e282 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -44,6 +44,14 @@ cl-print--depth
   "Depth of recursion within cl-print functions.
 Compared to `print-level' to determine when to stop recursing.")
 
+(defmacro cl--princ (obj &optional stream)
+  "Print a simple OBJ to STREAM.
+Bind `print-gensym' and `print-circle' to nil so that `princ'
+won't create a hash table (bug#36566)."
+  (declare (debug t))
+  `(let ((print-circle nil)
+         (print-gensym nil))
+     (princ ,obj ,stream)))
 
 ;;;###autoload
 (cl-defgeneric cl-print-object (object stream)
@@ -75,13 +83,13 @@ cl-print-object
                (consp object)
                (null (cdr object)))
           (progn
-            (princ (cond
+            (cl--princ (cond
                     ((eq car 'quote) '\')
                     ((eq car 'function) "#'")
                     (t car))
                    stream)
             (cl-print-object (car object) stream))
-        (princ "(" stream)
+        (cl--princ "(" stream)
         (cl-print-object car stream)
         (while (and (consp object)
                     (not (cond
@@ -90,15 +98,15 @@ cl-print-object
                           ((memq object cl-print--currently-printing))
                           (t (push object cl-print--currently-printing)
                              nil))))
-          (princ " " stream)
+          (cl--princ " " stream)
           (if (or (not (natnump print-length)) (> print-length count))
               (cl-print-object (pop object) stream)
             (cl-print-insert-ellipsis object print-length stream)
             (setq object nil))
           (cl-incf count))
         (when object
-          (princ " . " stream) (cl-print-object object stream))
-        (princ ")" stream)))))
+          (cl--princ " . " stream) (cl-print-object object stream))
+        (cl--princ ")" stream)))))
 
 (cl-defmethod cl-print-object-contents ((object cons) _start stream)
   (let ((count 0))
@@ -110,30 +118,30 @@ cl-print-object-contents
                       (t (push object cl-print--currently-printing)
                          nil))))
       (unless (zerop count)
-        (princ " " stream))
+        (cl--princ " " stream))
       (if (or (not (natnump print-length)) (> print-length count))
           (cl-print-object (pop object) stream)
         (cl-print-insert-ellipsis object print-length stream)
         (setq object nil))
       (cl-incf count))
     (when object
-      (princ " . " stream) (cl-print-object object stream))))
+      (cl--princ " . " stream) (cl-print-object object stream))))
 
 (cl-defmethod cl-print-object ((object vector) stream)
   (if (and cl-print--depth (natnump print-level)
            (> cl-print--depth print-level))
       (cl-print-insert-ellipsis object 0 stream)
-    (princ "[" stream)
+    (cl--princ "[" stream)
     (let* ((len (length object))
            (limit (if (natnump print-length)
                       (min print-length len) len)))
       (dotimes (i limit)
-        (unless (zerop i) (princ " " stream))
+        (unless (zerop i) (cl--princ " " stream))
         (cl-print-object (aref object i) stream))
       (when (< limit len)
-        (princ " " stream)
+        (cl--princ " " stream)
         (cl-print-insert-ellipsis object limit stream)))
-    (princ "]" stream)))
+    (cl--princ "]" stream)))
 
 (cl-defmethod cl-print-object-contents ((object vector) start stream)
   (let* ((len (length object))
@@ -141,22 +149,22 @@ cl-print-object-contents
                     (min (+ start print-length) len) len))
          (i start))
     (while (< i limit)
-      (unless (= i start) (princ " " stream))
+      (unless (= i start) (cl--princ " " stream))
       (cl-print-object (aref object i) stream)
       (cl-incf i))
     (when (< limit len)
-      (princ " " stream)
+      (cl--princ " " stream)
       (cl-print-insert-ellipsis object limit stream))))
 
 (cl-defmethod cl-print-object ((object hash-table) stream)
-  (princ "#<hash-table " stream)
+  (cl--princ "#<hash-table " stream)
   (princ (hash-table-test object) stream)
-  (princ " " stream)
-  (princ (hash-table-count object) stream)
-  (princ "/" stream)
-  (princ (hash-table-size object) stream)
-  (princ (format " %#x" (sxhash object)) stream)
-  (princ ">" stream))
+  (cl--princ " " stream)
+  (cl--princ (hash-table-count object) stream)
+  (cl--princ "/" stream)
+  (cl--princ (hash-table-size object) stream)
+  (cl--princ (format " %#x" (sxhash object)) stream)
+  (cl--princ ">" stream))
 
 (define-button-type 'help-byte-code
   'follow-link t
@@ -181,19 +189,19 @@ cl-print-compiled-button
 (cl-defmethod cl-print-object ((object compiled-function) stream)
   (unless stream (setq stream standard-output))
   ;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results.
-  (princ "#f(compiled-function " stream)
+  (cl--princ "#f(compiled-function " stream)
   (let ((args (help-function-arglist object 'preserve-names)))
     (if args
         (prin1 args stream)
-      (princ "()" stream)))
+      (cl--princ "()" stream)))
   (pcase (help-split-fundoc (documentation object 'raw) object)
     ;; Drop args which `help-function-arglist' already printed.
     (`(,_usage . ,(and doc (guard (stringp doc))))
-     (princ " " stream)
+     (cl--princ " " stream)
      (prin1 doc stream)))
   (let ((inter (interactive-form object)))
     (when inter
-      (princ " " stream)
+      (cl--princ " " stream)
       (cl-print-object
        (if (eq 'byte-code (car-safe (cadr inter)))
            `(interactive ,(make-byte-code nil (nth 1 (cadr inter))
@@ -202,26 +210,26 @@ cl-print-object
          inter)
        stream)))
   (if (eq cl-print-compiled 'disassemble)
-      (princ
+      (cl--princ
        (with-temp-buffer
          (insert "\n")
          (disassemble-1 object 0)
          (buffer-string))
        stream)
-    (princ " " stream)
+    (cl--princ " " stream)
     (let ((button-start (and cl-print-compiled-button
                              (bufferp stream)
                              (with-current-buffer stream (point)))))
-      (princ (format "#<bytecode %#x>" (sxhash object)) stream)
+      (cl--princ (format "#<bytecode %#x>" (sxhash object)) stream)
       (when (eq cl-print-compiled 'static)
-        (princ " " stream)
+        (cl--princ " " stream)
         (cl-print-object (aref object 2) stream))
       (when button-start
         (with-current-buffer stream
           (make-text-button button-start (point)
                             :type 'help-byte-code
                             'byte-code-function object)))))
-  (princ ")" stream))
+  (cl--princ ")" stream))
 
 ;; This belongs in nadvice.el, of course, but some load-ordering issues make it
 ;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add
@@ -231,24 +239,24 @@ cl-print-object
               ((object compiled-function) stream)
   (if (not (advice--p object))
       (cl-call-next-method)
-    (princ "#f(advice-wrapper " stream)
+    (cl--princ "#f(advice-wrapper " stream)
     (when (fboundp 'advice--where)
-      (princ (advice--where object) stream)
-      (princ " " stream))
+      (cl--princ (advice--where object) stream)
+      (cl--princ " " stream))
     (cl-print-object (advice--cdr object) stream)
-    (princ " " stream)
+    (cl--princ " " stream)
     (cl-print-object (advice--car object) stream)
     (let ((props (advice--props object)))
       (when props
-        (princ " " stream)
+        (cl--princ " " stream)
         (cl-print-object props stream)))
-    (princ ")" stream)))
+    (cl--princ ")" stream)))
 
 (cl-defmethod cl-print-object ((object cl-structure-object) stream)
   (if (and cl-print--depth (natnump print-level)
            (> cl-print--depth print-level))
       (cl-print-insert-ellipsis object 0 stream)
-    (princ "#s(" stream)
+    (cl--princ "#s(" stream)
     (let* ((class (cl-find-class (type-of object)))
            (slots (cl--struct-class-slots class))
            (len (length slots))
@@ -257,14 +265,14 @@ cl-print-object
       (princ (cl--struct-class-name class) stream)
       (dotimes (i limit)
         (let ((slot (aref slots i)))
-          (princ " :" stream)
+          (cl--princ " :" stream)
           (princ (cl--slot-descriptor-name slot) stream)
-          (princ " " stream)
+          (cl--princ " " stream)
           (cl-print-object (aref object (1+ i)) stream)))
       (when (< limit len)
-        (princ " " stream)
+        (cl--princ " " stream)
         (cl-print-insert-ellipsis object limit stream)))
-    (princ ")" stream)))
+    (cl--princ ")" stream)))
 
 (cl-defmethod cl-print-object-contents ((object cl-structure-object) start stream)
   (let* ((class (cl-find-class (type-of object)))
@@ -275,14 +283,14 @@ cl-print-object-contents
          (i start))
     (while (< i limit)
       (let ((slot (aref slots i)))
-        (unless (= i start) (princ " " stream))
-        (princ ":" stream)
-        (princ (cl--slot-descriptor-name slot) stream)
-        (princ " " stream)
+        (unless (= i start) (cl--princ " " stream))
+        (cl--princ ":" stream)
+        (cl--princ (cl--slot-descriptor-name slot) stream)
+        (cl--princ " " stream)
         (cl-print-object (aref object (1+ i)) stream))
       (cl-incf i))
     (when (< limit len)
-      (princ " " stream)
+      (cl--princ " " stream)
       (cl-print-insert-ellipsis object limit stream))))
 
 (cl-defmethod cl-print-object ((object string) stream)
@@ -298,7 +306,7 @@ cl-print-object
         (cl-print-insert-ellipsis object 0 stream)
       ;; Print all or part of the string
       (when has-properties
-        (princ "#(" stream))
+        (cl--princ "#(" stream))
       (if (= limit len)
           (prin1 (if has-properties (substring-no-properties object) object)
                  stream)
@@ -322,16 +330,16 @@ cl-print-object
                       (< start-pos len))
             (let ((props (text-properties-at start-pos object)))
               (when props
-                (princ " " stream) (princ start-pos stream)
-                (princ " " stream) (princ end-pos stream)
-                (princ " " stream) (cl-print-object props stream)
+                (cl--princ " " stream) (cl--princ start-pos stream)
+                (cl--princ " " stream) (cl--princ end-pos stream)
+                (cl--princ " " stream) (cl-print-object props stream)
                 (cl-incf interval-count))
               (setq start-pos end-pos
                     end-pos (next-property-change start-pos object len))))
           (when (< start-pos len)
-            (princ " " stream)
+            (cl--princ " " stream)
             (cl-print-insert-ellipsis object (list start-pos) stream)))
-        (princ ")" stream)))))
+        (cl--princ ")" stream)))))
 
 (cl-defmethod cl-print-object-contents ((object string) start stream)
   ;; If START is an integer, it is an index into the string, and the
@@ -346,7 +354,7 @@ cl-print-object-contents
                (substr (substring-no-properties object start limit))
                (printed (prin1-to-string substr))
                (trimmed (substring printed 1 (1- (length printed)))))
-          (princ trimmed)
+          (cl--princ trimmed stream)
           (when (< limit len)
             (cl-print-insert-ellipsis object limit stream)))
 
@@ -364,15 +372,15 @@ cl-print-object-contents
             (when props
               (if first
                   (setq first nil)
-                (princ " " stream))
-              (princ start-pos stream)
-              (princ " " stream) (princ end-pos stream)
-              (princ " " stream) (cl-print-object props stream)
+                (cl--princ " " stream))
+              (cl--princ start-pos stream)
+              (cl--princ " " stream) (cl--princ end-pos stream)
+              (cl--princ " " stream) (cl-print-object props stream)
               (cl-incf interval-count))
             (setq start-pos end-pos
                   end-pos (next-property-change start-pos object len))))
         (when (< start-pos len)
-          (princ " " stream)
+          (cl--princ " " stream)
           (cl-print-insert-ellipsis object (list start-pos) stream))))))
 
 ;;; Circularity and sharing.
@@ -391,16 +399,16 @@ cl-print-object
             (cl-call-next-method)
           (if (> n 0)
               ;; Already printed.  Just print a reference.
-              (progn (princ "#" stream) (princ n stream) (princ "#" stream))
+              (progn (cl--princ "#" stream) (cl--princ n stream) (cl--princ "#" stream))
             (puthash object (- n) cl-print--number-table)
-            (princ "#" stream) (princ (- n) stream) (princ "=" stream)
+            (cl--princ "#" stream) (cl--princ (- n) stream) (cl--princ "=" stream)
             (cl-call-next-method)))))
      ((let ((already-printing (memq object cl-print--currently-printing)))
         (when already-printing
           ;; Currently printing, just print reference to avoid endless
           ;; recursion.
-          (princ "#" stream)
-          (princ (length (cdr already-printing)) stream))))
+          (cl--princ "#" stream)
+          (cl--princ (length (cdr already-printing)) stream))))
      (t (let ((cl-print--currently-printing
                (cons object cl-print--currently-printing)))
           (cl-call-next-method))))))
@@ -470,7 +478,7 @@ cl-print-insert-ellipsis
   (unless stream (setq stream standard-output))
   (let ((ellipsis-start (and (bufferp stream)
                              (with-current-buffer stream (point)))))
-    (princ "..." stream)
+    (cl--princ "..." stream)
     (when ellipsis-start
       (with-current-buffer stream
         (cl-print-propertize-ellipsis object start ellipsis-start (point)
-- 
2.19.2

bug#36566: 27.0.50; debug is sometimes horribly slow

[Noam Postavsky]

Gemini Lasswell <gazally@runbox.com> writes:

> The third patch attached below fixes that by adding a macro to
> cl-print.el to wrap the printing of all the simple things with
> let-bindings of print-circle and print-gensym to nil.

> Patch #3 has the advantage of being straightforward logically and not
> breaking anything which doesn't use cl-prin1, but it undoubtedly also
> slows down cl-prin1 in the probably more common case that print-gensym
> and print-circle are both nil.  There are other ways to fix this, such
> as by adding a new entry point in print.c for printing simple strings,
> or by modifying the logic in print_preprocess to not create a hash table
> if the top-level object is a string with no properties.

This last idea sounds like a straightforward win to me, with no obvious
drawbacks.  I mean, no point in allocating a hash table if we can
cheaply detect it will never be used, right?

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

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

Noam Postavsky <npostavs@gmail.com> writes:

>>
>> ...by modifying the logic in print_preprocess to not create a hash table
>> if the top-level object is a string with no properties.
>
> This last idea sounds like a straightforward win to me, with no obvious
> drawbacks.  I mean, no point in allocating a hash table if we can
> cheaply detect it will never be used, right?

I made that change, and then, in studying the uses of
print-number-table, found more cases in which allocated hash tables were
never used.  Since 2011 when byte-compile-disable-print-circle was
marked obsolete and 2012 when commit 4ae29f89be changed the logic in
print_object, the only time print-number-table gets used is when
print-circle is non-nil.

Because of that observation, I have added a patch which makes it so that
print_preprocess is only called to create print-number-table when
print_circle is non-nil.  The patch also simplifies print_preprocess
accordingly.  In order to test that change thoroughly I added a couple
new print tests and reorganized the existing print tests so that all
functionality common between print.c and cl-print.el is now tested by
the same tests, located in src/print-tests.el.

Michael's use case is down to 0.7s on my machine.



[-- Attachment #2: 0001-Improve-print-output-options-commands-in-backtrace-m.patch --]
[-- Type: text/plain, Size: 9239 bytes --]

From 12c28d02ee7dc34133f5cd1352d6d65f86509bb7 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 30 Jul 2019 10:00:27 -0700
Subject: [PATCH 1/5] Improve print output options commands in backtrace-mode
 (bug#36566)

* lisp/emacs-lisp/backtrace.el (backtrace-view): Mention
:print-gensym in docstring.
(backtrace-mode-map): Add keyboard binding for
backtrace-toggle-print-gensym.  Add menu entries for
backtrace-toggle-print-circle and backtrace-toggle-print-gensym.
(backtrace--with-output-variables): Bind print-gensym with value
of :print-gensym found in view plist.
(backtrace-toggle-print-circle): Remove description of
implementation details from docstring.
(backtrace-toggle-print-gensym): New command.
(backtrace--toggle-feature): Add echo area message describing result
of command.

* test/lisp/emacs-lisp/backtrace-tests.el
(backtrace-tests--print-circle): New test.

* doc/lispref/debugging.texi (Backtraces): Document keyboard
binding for backtrace-toggle-print-gensym.
---
 doc/lispref/debugging.texi              |  3 ++
 lisp/emacs-lisp/backtrace.el            | 44 +++++++++++++++++-----
 test/lisp/emacs-lisp/backtrace-tests.el | 49 +++++++++++++++++++++++++
 3 files changed, 86 insertions(+), 10 deletions(-)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 9e43343310..5393b2766a 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -457,6 +457,9 @@ Backtraces
 @item #
 Toggle @code{print-circle} for the frame at point.
 
+@item :
+Toggle @code{print-gensym} for the frame at point.
+
 @item .
 Expand all the forms abbreviated with ``...'' in the frame at point.
 
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 60d146e24a..0c4c7987c3 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -175,7 +175,8 @@ backtrace-frames
 
 (defvar-local backtrace-view nil
   "A plist describing how to render backtrace frames.
-Possible entries are :show-flags, :show-locals and :print-circle.")
+Possible entries are :show-flags, :show-locals, :print-circle
+and :print-gensym.")
 
 (defvar-local backtrace-insert-header-function nil
   "Function for inserting a header for the current Backtrace buffer.
@@ -205,6 +206,7 @@ backtrace-mode-map
     (define-key map "p" 'backtrace-backward-frame)
     (define-key map "v" 'backtrace-toggle-locals)
     (define-key map "#" 'backtrace-toggle-print-circle)
+    (define-key map ":" 'backtrace-toggle-print-gensym)
     (define-key map "s" 'backtrace-goto-source)
     (define-key map "\C-m" 'backtrace-help-follow-symbol)
     (define-key map "+" 'backtrace-multi-line)
@@ -224,6 +226,18 @@ backtrace-mode-map
          :active (backtrace-get-index)
          :selected (plist-get (backtrace-get-view) :show-locals)
          :help "Show or hide the local variables for the frame at point"]
+        ["Show Circular Structures" backtrace-toggle-print-circle
+         :style toggle
+         :active (backtrace-get-index)
+         :selected (plist-get (backtrace-get-view) :print-circle)
+         :help
+         "Condense or expand shared or circular structures in the frame at point"]
+        ["Show Uninterned Symbols" backtrace-toggle-print-gensym
+         :style toggle
+         :active (backtrace-get-index)
+         :selected (plist-get (backtrace-get-view) :print-gensym)
+         :help
+         "Toggle unique printing of uninterned symbols in the frame at point"]
         ["Expand \"...\"s" backtrace-expand-ellipses
          :help "Expand all the abbreviated forms in the current frame"]
         ["Show on Multiple Lines" backtrace-multi-line
@@ -339,6 +353,7 @@ backtrace--with-output-variables
   `(let ((print-escape-control-characters t)
          (print-escape-newlines t)
          (print-circle (plist-get ,view :print-circle))
+         (print-gensym (plist-get ,view :print-gensym))
          (standard-output (current-buffer)))
      ,@body))
 
@@ -420,12 +435,18 @@ backtrace--change-button-skip
 
 (defun backtrace-toggle-print-circle (&optional all)
   "Toggle `print-circle' for the backtrace frame at point.
-With prefix argument ALL, toggle the value of :print-circle in
-`backtrace-view', which affects all of the backtrace frames in
-the buffer."
+With prefix argument ALL, toggle the default value bound to
+`print-circle' for all the frames in the buffer."
   (interactive "P")
   (backtrace--toggle-feature :print-circle all))
 
+(defun backtrace-toggle-print-gensym (&optional all)
+  "Toggle `print-gensym' for the backtrace frame at point.
+With prefix argument ALL, toggle the default value bound to
+`print-gensym' for all the frames in the buffer."
+  (interactive "P")
+  (backtrace--toggle-feature :print-gensym all))
+
 (defun backtrace--toggle-feature (feature all)
   "Toggle FEATURE for the current backtrace frame or for the buffer.
 FEATURE should be one of the options in `backtrace-view'.  If ALL
@@ -450,12 +471,15 @@ backtrace--toggle-feature
           (goto-char (point-min))
           (while (and (not (eql index (backtrace-get-index)))
                       (< (point) (point-max)))
-            (goto-char (backtrace-get-frame-end)))))
-    (let ((index (backtrace-get-index)))
-      (unless index
-        (user-error "Not in a stack frame"))
-      (backtrace--set-feature feature
-                              (not (plist-get (backtrace-get-view) feature))))))
+            (goto-char (backtrace-get-frame-end))))
+        (message "%s is now %s for all frames"
+                 (substring (symbol-name feature) 1) value))
+    (unless (backtrace-get-index)
+      (user-error "Not in a stack frame"))
+    (let ((value (not (plist-get (backtrace-get-view) feature))))
+      (backtrace--set-feature feature value)
+      (message "%s is now %s for this frame"
+               (substring (symbol-name feature) 1) value))))
 
 (defun backtrace--set-feature (feature value)
   "Set FEATURE in the view plist of the frame at point to VALUE.
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index ce827e0166..be15495342 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -335,6 +335,55 @@ backtrace-tests--print-circle
       (should (string-match-p results
                               (backtrace-tests--get-substring (point-min) (point-max)))))))
 
+(ert-deftest backtrace-tests--print-gensym ()
+  "Backtrace buffers can toggle `print-gensym' syntax."
+  (ert-with-test-buffer (:name "print-gensym")
+    (let* ((print-gensym nil)
+           (arg (list (gensym "first") (gensym) (gensym "last")))
+           (results (backtrace-tests--make-regexp
+                     (backtrace-tests--result arg)))
+           (results-gensym (regexp-quote (let ((print-gensym t))
+                                           (backtrace-tests--result arg))))
+           (last-frame (backtrace-tests--make-regexp
+                        (format (nth (1- backtrace-tests--line-count)
+                                     (backtrace-tests--backtrace-lines))
+                                arg)))
+           (last-frame-gensym (regexp-quote
+                               (let ((print-gensym t))
+                                 (format (nth (1- backtrace-tests--line-count)
+                                              (backtrace-tests--backtrace-lines))
+                                         arg)))))
+      (backtrace-tests--make-backtrace arg)
+      (backtrace-print)
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Go to the last frame.
+      (goto-char (point-max))
+      (forward-line -1)
+      ;; Turn on print-gensym for that frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      ;; Turn off print-gensym for the frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym on for the buffer.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results-gensym
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym off.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring
+                               (point) (+ (point) (length last-frame)))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max)))))))
+
 (defun backtrace-tests--make-regexp (str)
   "Make regexp from STR for `backtrace-tests--print-circle'.
 Used for results of printing circular objects without
-- 
2.19.2


[-- Attachment #3: 0002-Improve-performance-of-backtrace-printing-bug-36566.patch --]
[-- Type: text/plain, Size: 2227 bytes --]

From 99a05473fe9c5aef5619585733265c715ac93f01 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 30 Jul 2019 11:56:51 -0700
Subject: [PATCH 2/5] Improve performance of backtrace printing (bug#36566)

* lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
print-level and print-length more quickly when the structure being
printed is very large.
---
 lisp/emacs-lisp/cl-print.el | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5fe3dd1b91..530770128e 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -548,21 +548,22 @@ cl-print-to-string-with-limit
   ;; call_debugger (bug#31919).
   (let* ((print-length (when limit (min limit 50)))
          (print-level (when limit (min 8 (truncate (log limit)))))
-         (delta (when limit
-                  (max 1 (truncate (/ print-length print-level))))))
+         (delta-length (when limit
+                         (max 1 (truncate (/ print-length print-level))))))
     (with-temp-buffer
       (catch 'done
         (while t
           (erase-buffer)
           (funcall print-function value (current-buffer))
-          ;; Stop when either print-level is too low or the value is
-          ;; successfully printed in the space allowed.
-          (when (or (not limit)
-                    (< (- (point-max) (point-min)) limit)
-                    (= print-level 2))
-            (throw 'done (buffer-string)))
-          (cl-decf print-level)
-          (cl-decf print-length delta))))))
+          (let ((result (- (point-max) (point-min))))
+            ;; Stop when either print-level is too low or the value is
+            ;; successfully printed in the space allowed.
+            (when (or (not limit) (< result limit) (<= print-level 2))
+              (throw 'done (buffer-string)))
+            (let* ((ratio (/ result limit))
+                   (delta-level (max 1 (min (- print-level 2) ratio))))
+              (cl-decf print-level delta-level)
+              (cl-decf print-length (* delta-length delta-level)))))))))
 
 (provide 'cl-print)
 ;;; cl-print.el ends here
-- 
2.19.2


[-- Attachment #4: 0003-Fix-unnecessary-hash-table-creation-in-cl-prin1-bug-.patch --]
[-- Type: text/plain, Size: 1951 bytes --]

From f6938cbc35b31c6c22dc36fc28c50e5e3cbfa3c1 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Sat, 3 Aug 2019 12:33:20 -0700
Subject: [PATCH 3/5] Fix unnecessary hash table creation in cl-prin1
 (bug#36566)

cl-prin1 prints all its punctuation by passing strings to prin1.  When
print-circle was set, print_preprocess was creating a new hash table
for each string, causing excessive garbage collection when printing
large Lisp objects with cl-prin1.

* src/print.c (print_number_index): Fix typo in comment above.
(PRINT_CIRCLE_CANDIDATE_P): Don't create print_number_table
for top-level strings with no properties, except when
print_continuous_numbering is on.
---
 src/print.c | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/print.c b/src/print.c
index 7c3da68fc9..18330b0fbf 100644
--- a/src/print.c
+++ b/src/print.c
@@ -81,7 +81,7 @@ #define PRINT_CIRCLE 200
      -N   the object will be printed several times and will take number N.
      N    the object has been printed so we can refer to it as #N#.
    print_number_index holds the largest N already used.
-   N has to be striclty larger than 0 since we need to distinguish -N.  */
+   N has to be strictly larger than 0 since we need to distinguish -N.  */
 static ptrdiff_t print_number_index;
 static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
 
@@ -1149,7 +1149,11 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 }
 
 #define PRINT_CIRCLE_CANDIDATE_P(obj)			   \
-  (STRINGP (obj) || CONSP (obj)				   \
+  ((STRINGP (obj)                                          \
+       && (string_intervals (obj)                          \
+	  || print_depth > 1				   \
+	  || Vprint_continuous_numbering))		   \
+   || CONSP (obj)					   \
    || (VECTORLIKEP (obj)				   \
        && (VECTORP (obj) || COMPILEDP (obj)		   \
 	   || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
-- 
2.19.2


[-- Attachment #5: 0004-Create-common-tests-for-print.c-and-cl-print.el.patch --]
[-- Type: text/plain, Size: 21759 bytes --]

From fe609299d83df807b0c5dde948a4d753f94f7511 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Sun, 4 Aug 2019 15:56:12 -0700
Subject: [PATCH 4/5] Create common tests for print.c and cl-print.el

* test/lisp/emacs-lisp/cl-print-tests.el:
(cl-print--test, cl-print-tests-1, cl-print-tests-2)
(cl-print-tests-3, cl-print-tests-4, cl-print-tests-5)
(cl-print-tests-strings, cl-print-circle, cl-print-circle-2):
Remove.
* test/src/print-tests.el (print-tests--prin1-to-string): New
alias.
(print-tests--deftest): New macro.
(print-hex-backslash, print-read-roundtrip, print-bignum): Define with
print-tests--deftest and use print-tests--prin1-to-string.
(print-tests--prints-with-charset-p): Use
print-tests--prin1-to-string.
(print-tests--print-charset-text-property-nil)
(print-tests--print-charset-text-property-t)
(print-tests--print-charset-text-property-default): Define with
print-tests--deftest.
(print-tests-print-gensym)
(print-tests-continuous-numbering, print-tests-1, print-tests-2)
(print-tests-3, print-tests-4, print-tests-5)
(print-tests-strings, print-circle, print-circle-2): New tests.
(print--test, print-tests-struct): New cl-defstructs.
---
 test/lisp/emacs-lisp/cl-print-tests.el | 115 +----------
 test/src/print-tests.el                | 259 +++++++++++++++++++++++--
 2 files changed, 250 insertions(+), 124 deletions(-)

diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index 406c528dce..31d79df71b 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -19,109 +19,17 @@
 
 ;;; Commentary:
 
+;; See test/src/print-tests.el for tests which apply to both
+;; cl-print.el and src/print.c.
+
 ;;; Code:
 
 (require 'ert)
 
-(cl-defstruct cl-print--test a b)
-
-(ert-deftest cl-print-tests-1 ()
-  "Test cl-print code."
-  (let ((x (make-cl-print--test :a 1 :b 2)))
-    (let ((print-circle nil))
-      (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
-                     "((x . #s(cl-print--test :a 1 :b 2)) (y . #s(cl-print--test :a 1 :b 2)))")))
-    (let ((print-circle t))
-      (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
-                     "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
-    (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^)]*)\\'"
-                          (cl-prin1-to-string (symbol-function #'caar))))))
-
-(ert-deftest cl-print-tests-2 ()
-  (let ((x (record 'foo 1 2 3)))
-    (should (equal
-             x
-             (car (read-from-string (with-output-to-string (prin1 x))))))
-    (let ((print-circle t))
-      (should (string-match
-               "\\`(#1=#s(foo 1 2 3) #1#)\\'"
-               (cl-prin1-to-string (list x x)))))))
-
 (cl-defstruct (cl-print-tests-struct
                (:constructor cl-print-tests-con))
   a b c d e)
 
-(ert-deftest cl-print-tests-3 ()
-  "CL printing observes `print-length'."
-  (let ((long-list (make-list 5 'a))
-        (long-vec (make-vector 5 'b))
-        (long-struct (cl-print-tests-con))
-        (long-string (make-string 5 ?a))
-        (print-length 4))
-    (should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
-    (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
-    (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
-                   (cl-prin1-to-string long-struct)))
-    (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string)))))
-
-(ert-deftest cl-print-tests-4 ()
-  "CL printing observes `print-level'."
-  (let* ((deep-list '(a (b (c (d (e))))))
-         (buried-vector '(a (b (c (d [e])))))
-         (deep-struct (cl-print-tests-con))
-         (buried-struct `(a (b (c (d ,deep-struct)))))
-         (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t)))))))
-         (buried-simple-string '(a (b (c (d "hello")))))
-         (print-level 4))
-    (setf (cl-print-tests-struct-a deep-struct) deep-list)
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string)))
-    (should (equal "(a (b (c (d \"hello\"))))"
-                   (cl-prin1-to-string buried-simple-string)))
-    (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
-                   (cl-prin1-to-string deep-struct)))))
-
-(ert-deftest cl-print-tests-5 ()
-  "CL printing observes `print-quoted'."
-  (let ((quoted-stuff '('a #'b `(,c ,@d))))
-    (let ((print-quoted t))
-      (should (equal "('a #'b `(,c ,@d))"
-                     (cl-prin1-to-string quoted-stuff))))
-    (let ((print-quoted nil))
-      (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
-                     (cl-prin1-to-string quoted-stuff))))))
-
-(ert-deftest cl-print-tests-strings ()
-  "CL printing prints strings and propertized strings."
-  (let* ((str1 "abcdefghij")
-         (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
-         (str3 #("abcdefghij" 0 10 (test t)))
-         (obj '(a b))
-         ;; Since the byte compiler reuses string literals,
-         ;; and the put-text-property call is destructive, use
-         ;; copy-sequence to make a new string.
-         (str4 (copy-sequence "abcdefghij")))
-    (put-text-property 0 5 'test obj str4)
-    (put-text-property 7 10 'test obj str4)
-
-    (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1)))
-    (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
-                   (cl-prin1-to-string str2)))
-    (should (equal "#(\"abcdefghij\" 0 10 (test t))"
-                   (cl-prin1-to-string str3)))
-    (let ((print-circle nil))
-      (should
-       (equal
-        "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
-        (cl-prin1-to-string str4))))
-    (let ((print-circle t))
-      (should
-       (equal
-        "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
-        (cl-prin1-to-string str4))))))
-
 (ert-deftest cl-print-tests-ellipsis-cons ()
   "Ellipsis expansion works in conses."
   (let ((print-length 4)
@@ -216,23 +124,6 @@ cl-print-tests-check-ellipsis-expansion-rx
     (should (string-match expanded (with-output-to-string
                                      (cl-print-expand-ellipsis value nil))))))
 
-(ert-deftest cl-print-circle ()
-  (let ((x '(#1=(a . #1#) #1#)))
-    (let ((print-circle nil))
-      (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
-                            (cl-prin1-to-string x))))
-    (let ((print-circle t))
-      (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x))))))
-
-(ert-deftest cl-print-circle-2 ()
-  ;; Bug#31146.
-  (let ((x '(0 . #1=(0 . #1#))))
-    (let ((print-circle nil))
-      (should (string-match "\\`(0 0 . #[0-9])\\'"
-                            (cl-prin1-to-string x))))
-    (let ((print-circle t))
-      (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
-
 (ert-deftest cl-print-tests-print-to-string-with-limit ()
   (let* ((thing10 (make-list 10 'a))
          (thing100 (make-list 100 'a))
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 8e377d7180..26d49a5ffb 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -21,42 +21,86 @@
 
 (require 'ert)
 
-(ert-deftest print-hex-backslash ()
+;; Support sharing test code with cl-print-tests.
+
+(defalias 'print-tests--prin1-to-string #'identity
+  "The function to print to a string which is under test.")
+
+(defmacro print-tests--deftest (name arg &rest docstring-keys-and-body)
+  "Test both print.c and cl-print.el at once."
+  (declare (debug ert-deftest)
+           (doc-string 3)
+           (indent 2))
+  (let ((clname (intern (concat (symbol-name name) "-cl-print")))
+        (doc (when (stringp (car-safe docstring-keys-and-body))
+               (list (pop docstring-keys-and-body))))
+        (keys-and-values nil))
+    (while (keywordp (car-safe docstring-keys-and-body))
+      (let ((key (pop docstring-keys-and-body))
+            (val (pop docstring-keys-and-body)))
+        (push val keys-and-values)
+        (push key keys-and-values)))
+    `(progn
+       ;; Set print-tests--prin1-to-string at both declaration and
+       ;; runtime, so that it can be used by the :expected-result
+       ;; keyword.
+       (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                  #'prin1-to-string))
+         (ert-deftest ,name ,arg
+           ,@doc
+           ,@keys-and-values
+           (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                      #'prin1-to-string))
+             ,@docstring-keys-and-body)))
+       (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                  #'cl-prin1-to-string))
+         (ert-deftest ,clname ,arg
+           ,@doc
+           ,@keys-and-values
+           (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                      #'cl-prin1-to-string))
+             ,@docstring-keys-and-body))))))
+
+(print-tests--deftest print-hex-backslash ()
   (should (string= (let ((print-escape-multibyte t)
                          (print-escape-newlines t))
-                     (prin1-to-string "\u00A2\ff"))
+                     (print-tests--prin1-to-string "\u00A2\ff"))
                    "\"\\x00a2\\ff\"")))
 
 (defun print-tests--prints-with-charset-p (ch odd-charset)
-  "Return t if `prin1-to-string' prints CH with the `charset' property.
+  "Return t if print function being tested prints CH with the `charset' property.
 CH is propertized with a `charset' value according to
 ODD-CHARSET: if nil, then use the one returned by `char-charset',
 otherwise, use a different charset."
   (integerp
    (string-match
     "charset"
-    (prin1-to-string
+    (print-tests--prin1-to-string
      (propertize (string ch)
                  'charset
                  (if odd-charset
                      (cl-find (char-charset ch) charset-list :test-not #'eq)
                    (char-charset ch)))))))
 
-(ert-deftest print-charset-text-property-nil ()
+(print-tests--deftest print-charset-text-property-nil ()
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
   (let ((print-charset-text-property nil))
     (should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376.
     (should-not (print-tests--prints-with-charset-p ?a t))
     (should-not (print-tests--prints-with-charset-p ?\xf6 nil))
     (should-not (print-tests--prints-with-charset-p ?a nil))))
 
-(ert-deftest print-charset-text-property-default ()
+(print-tests--deftest print-charset-text-property-default ()
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
   (let ((print-charset-text-property 'default))
     (should (print-tests--prints-with-charset-p ?\xf6 t))
     (should-not (print-tests--prints-with-charset-p ?a t))
     (should-not (print-tests--prints-with-charset-p ?\xf6 nil))
     (should-not (print-tests--prints-with-charset-p ?a nil))))
 
-(ert-deftest print-charset-text-property-t ()
+(print-tests--deftest print-charset-text-property-t ()
   (let ((print-charset-text-property t))
     (should (print-tests--prints-with-charset-p ?\xf6 t))
     (should (print-tests--prints-with-charset-p ?a t))
@@ -94,7 +138,7 @@ terpri
                        (buffer-string))
                      "--------\n"))))
 
-(ert-deftest print-read-roundtrip ()
+(print-tests--deftest print-read-roundtrip ()
   (let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\"
                     '\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0
                     '\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN
@@ -105,16 +149,207 @@ print-read-roundtrip
                     (intern "\N{ZERO WIDTH SPACE}")
                     (intern "\0"))))
     (dolist (sym syms)
-      (should (eq (read (prin1-to-string sym)) sym))
+      (should (eq (read (print-tests--prin1-to-string sym)) sym))
       (dolist (sym1 syms)
         (let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1)))))
-          (should (eq (read (prin1-to-string sym2)) sym2)))))))
+          (should (eq (read (print-tests--prin1-to-string sym2)) sym2)))))))
 
-(ert-deftest print-bignum ()
+(print-tests--deftest print-bignum ()
   (let* ((str "999999999999999999999999999999999")
          (val (read str)))
     (should (> val most-positive-fixnum))
-    (should (equal (prin1-to-string val) str))))
+    (should (equal (print-tests--prin1-to-string val) str))))
+
+(print-tests--deftest print-tests-print-gensym ()
+  "Printing observes `print-gensym'."
+  (let* ((sym1 (gensym))
+         (syms (list sym1 (gensym "x") (make-symbol "y") sym1)))
+    (let* ((print-circle nil)
+           (printed-with (let ((print-gensym t))
+                           (print-tests--prin1-to-string syms)))
+           (printed-without (let ((print-gensym nil))
+                              (print-tests--prin1-to-string syms))))
+      (should (string-match
+               "(#:\\(g[[:digit:]]+\\) #:x[[:digit:]]+ #:y #:\\(g[[:digit:]]+\\))$"
+               printed-with))
+      (should (string= (match-string 1 printed-with)
+                       (match-string 2 printed-with)))
+      (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+                            printed-without)))
+    (let* ((print-circle t)
+           (printed-with (let ((print-gensym t))
+                           (print-tests--prin1-to-string syms)))
+           (printed-without (let ((print-gensym nil))
+                              (print-tests--prin1-to-string syms))))
+      (should (string-match "(#1=#:g[[:digit:]]+ #:x[[:digit:]]+ #:y #1#)$"
+                            printed-with))
+      (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+                            printed-without)))))
+
+(print-tests--deftest print-tests-continuous-numbering ()
+  "Printing observes `print-continuous-numbering'."
+  ;; cl-print does not support print-continuous-numbering.
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
+  (let* ((x (list 1))
+         (y "hello")
+         (g (gensym))
+         (g2 (gensym))
+         (print-circle t)
+         (print-gensym t))
+    (let ((print-continuous-numbering t)
+          (print-number-table nil))
+      (should (string-match
+               "(#1=(1) #1# #2=\"hello\" #2#)(#3=#:g[[:digit:]]+ #3#)(#1# #2# #3#)#2#$"
+               (mapconcat #'print-tests--prin1-to-string `((,x ,x ,y ,y) (,g ,g) (,x ,y ,g) ,y) ""))))
+
+    ;; This is the special case for byte-compile-output-docform
+    ;; mentioned in a comment in print_preprocess.  When
+    ;; print-continuous-numbering and print-circle and print-gensym
+    ;; are all non-nil, print all gensyms with numbers even if they
+    ;; only occur once.
+    (let ((print-continuous-numbering t)
+          (print-number-table nil))
+      (should (string-match
+               "(#1=#:g[[:digit:]]+ #2=#:g[[:digit:]]+)$"
+               (print-tests--prin1-to-string (list g g2)))))))
+
+(cl-defstruct print--test a b)
+
+(print-tests--deftest print-tests-1 ()
+  "Test print code."
+  (let ((x (make-print--test :a 1 :b 2))
+        (rec (cond
+              ((eq (symbol-function #'print-tests--prin1-to-string) 'prin1-to-string)
+               "#s(print--test 1 2)")
+              ((eq (symbol-function #'print-tests--prin1-to-string) 'cl-prin1-to-string)
+               "#s(print--test :a 1 :b 2)")
+              (t (cl-assert nil)))))
+
+    (let ((print-circle nil))
+      (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+                     (format "((x . %s) (y . %s))" rec rec))))
+    (let ((print-circle t))
+      (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+                     (format "((x . #1=%s) (y . #1#))" rec))))))
+
+(print-tests--deftest print-tests-2 ()
+  (let ((x (record 'foo 1 2 3)))
+    (should (equal
+             x
+             (car (read-from-string (with-output-to-string (prin1 x))))))
+    (let ((print-circle t))
+      (should (string-match
+               "\\`(#1=#s(foo 1 2 3) #1#)\\'"
+               (print-tests--prin1-to-string (list x x)))))))
+
+(cl-defstruct (print-tests-struct
+               (:constructor print-tests-con))
+  a b c d e)
+
+(print-tests--deftest print-tests-3 ()
+  "Printing observes `print-length'."
+  (let ((long-list (make-list 5 'a))
+        (long-vec (make-vector 5 'b))
+        ;; (long-struct (print-tests-con))
+        ;; (long-string (make-string 5 ?a))
+        (print-length 4))
+    (should (equal "(a a a a ...)" (print-tests--prin1-to-string long-list)))
+    (should (equal "[b b b b ...]" (print-tests--prin1-to-string long-vec)))
+    ;; This one only prints 3 nils. Should it print 4?
+    ;; (should (equal "#s(print-tests-struct nil nil nil nil ...)"
+    ;;                (print-tests--prin1-to-string long-struct)))
+    ;; This one is only supported by cl-print
+    ;; (should (equal "\"aaaa...\"" (cl-print-tests--prin1-to-string long-string)))
+    ))
+
+(print-tests--deftest print-tests-4 ()
+  "Printing observes `print-level'."
+  (let* ((deep-list '(a (b (c (d (e))))))
+         (buried-vector '(a (b (c (d [e])))))
+         (deep-struct (print-tests-con))
+         (buried-struct `(a (b (c (d ,deep-struct)))))
+         (buried-string '(a (b (c (d #("hello" 0 5 (print-test t)))))))
+         (buried-simple-string '(a (b (c (d "hello")))))
+         (print-level 4))
+    (setf (print-tests-struct-a deep-struct) deep-list)
+    (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string deep-list)))
+    (should (equal "(a (b (c (d \"hello\"))))"
+                   (print-tests--prin1-to-string buried-simple-string)))
+    (cond
+     ((eq (symbol-function #'print-tests--prin1-to-string) #'prin1-to-string)
+      (should (equal "(a (b (c (d [e]))))" (print-tests--prin1-to-string buried-vector)))
+      (should (equal "(a (b (c (d #s(print-tests-struct ... nil nil nil nil)))))"
+                     (print-tests--prin1-to-string buried-struct)))
+      (should (equal "(a (b (c (d #(\"hello\" 0 5 ...)))))"
+                     (print-tests--prin1-to-string buried-string)))
+      (should (equal "#s(print-tests-struct (a (b (c ...))) nil nil nil nil)"
+                     (print-tests--prin1-to-string deep-struct))))
+
+     ((eq (symbol-function #'print-tests--prin1-to-string) #'cl-prin1-to-string)
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-vector)))
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-struct)))
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-string)))
+      (should (equal "#s(print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
+                     (print-tests--prin1-to-string deep-struct))))
+     (t (cl-assert nil)))))
+
+(print-tests--deftest print-tests-5 ()
+  "Printing observes `print-quoted'."
+  (let ((quoted-stuff '('a #'b `(,c ,@d))))
+    (let ((print-quoted t))
+      (should (equal "('a #'b `(,c ,@d))"
+                     (print-tests--prin1-to-string quoted-stuff))))
+    (let ((print-quoted nil))
+      (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
+                     (print-tests--prin1-to-string quoted-stuff))))))
+
+(print-tests--deftest print-tests-strings ()
+  "Can print strings and propertized strings."
+  (let* ((str1 "abcdefghij")
+         (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
+         (str3 #("abcdefghij" 0 10 (test t)))
+         (obj '(a b))
+         ;; Since the byte compiler reuses string literals,
+         ;; and the put-text-property call is destructive, use
+         ;; copy-sequence to make a new string.
+         (str4 (copy-sequence "abcdefghij")))
+    (put-text-property 0 5 'test obj str4)
+    (put-text-property 7 10 'test obj str4)
+
+    (should (equal "\"abcdefghij\"" (print-tests--prin1-to-string str1)))
+    (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
+                   (print-tests--prin1-to-string str2)))
+    (should (equal "#(\"abcdefghij\" 0 10 (test t))"
+                   (print-tests--prin1-to-string str3)))
+    (let ((print-circle nil))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
+        (print-tests--prin1-to-string str4))))
+    (let ((print-circle t))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
+        (print-tests--prin1-to-string str4))))))
+
+(print-tests--deftest print-circle ()
+  (let ((x '(#1=(a . #1#) #1#)))
+    (let ((print-circle nil))
+      (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
+                            (print-tests--prin1-to-string x))))
+    (let ((print-circle t))
+      (should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x))))))
+
+(print-tests--deftest print-circle-2 ()
+   ;; Bug#31146.
+  (let ((x '(0 . #1=(0 . #1#))))
+    (let ((print-circle nil))
+      (should (string-match "\\`(0 0 . #[0-9])\\'"
+                            (print-tests--prin1-to-string x))))
+    (let ((print-circle t))
+      (should (equal "(0 . #1=(0 . #1#))" (print-tests--prin1-to-string x))))))
+
 
 (provide 'print-tests)
 ;;; print-tests.el ends here
-- 
2.19.2


[-- Attachment #6: 0005-Don-t-build-print-number-table-unless-it-will-be-use.patch --]
[-- Type: text/plain, Size: 6502 bytes --]

From 1daf6a369e1fb23a2a761b2cd5fc0bdbbc8bb877 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Sat, 3 Aug 2019 21:39:29 -0700
Subject: [PATCH 5/5] Don't build print-number-table unless it will be used

There are only a few users of print-number-table, and none of them use
it when print-circle is nil.  A couple of them used to.  print_object
was changed to not use print-number-table unless print-circle is non-nil
in commit 4ae29f89be.  byte-compile-output-docform which uses
print-number-table binds print-circle to t before printing unless
byte-compile-disable-print-circle is set, but that variable has been
marked obsolete since 24.1.

* src/print.c (print_preprocess): Assert Vprint_circle is non-nil.
Remove code handling the case when Vprint_circle is nil.
(print, Fprint_preprocess): Don't call print_preprocess unless
Vprint_circle is non-nil.
(print_object): Remove comment referencing removed code in
print_preprocess.
---
 src/print.c | 92 +++++++++++++++++++++++------------------------------
 1 file changed, 39 insertions(+), 53 deletions(-)

diff --git a/src/print.c b/src/print.c
index 18330b0fbf..c870aa5a08 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1120,8 +1120,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       Vprint_number_table = Qnil;
     }
 
-  /* Construct Vprint_number_table for print-gensym and print-circle.  */
-  if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
+  /* Construct Vprint_number_table for print-circle.  */
+  if (!NILP (Vprint_circle))
     {
       /* Construct Vprint_number_table.
 	 This increments print_number_index for the objects added.  */
@@ -1163,13 +1163,14 @@ #define PRINT_CIRCLE_CANDIDATE_P(obj)			   \
        && SYMBOLP (obj)					   \
        && !SYMBOL_INTERNED_P (obj)))
 
-/* Construct Vprint_number_table according to the structure of OBJ.
-   OBJ itself and all its elements will be added to Vprint_number_table
-   recursively if it is a list, vector, compiled function, char-table,
-   string (its text properties will be traced), or a symbol that has
-   no obarray (this is for the print-gensym feature).
-   The status fields of Vprint_number_table mean whether each object appears
-   more than once in OBJ: Qnil at the first time, and Qt after that.  */
+/* Construct Vprint_number_table for the print-circle feature
+   according to the structure of OBJ.  OBJ itself and all its elements
+   will be added to Vprint_number_table recursively if it is a list,
+   vector, compiled function, char-table, string (its text properties
+   will be traced), or a symbol that has no obarray (this is for the
+   print-gensym feature).  The status fields of Vprint_number_table
+   mean whether each object appears more than once in OBJ: Qnil at the
+   first time, and Qt after that.  */
 static void
 print_preprocess (Lisp_Object obj)
 {
@@ -1178,20 +1179,7 @@ print_preprocess (Lisp_Object obj)
   int loop_count = 0;
   Lisp_Object halftail;
 
-  /* Avoid infinite recursion for circular nested structure
-     in the case where Vprint_circle is nil.  */
-  if (NILP (Vprint_circle))
-    {
-      /* Give up if we go so deep that print_object will get an error.  */
-      /* See similar code in print_object.  */
-      if (print_depth >= PRINT_CIRCLE)
-	error ("Apparently circular structure being printed");
-
-      for (i = 0; i < print_depth; i++)
-	if (EQ (obj, being_printed[i]))
-	  return;
-      being_printed[print_depth] = obj;
-    }
+  eassert (!NILP (Vprint_circle));
 
   print_depth++;
   halftail = obj;
@@ -1202,33 +1190,28 @@ print_preprocess (Lisp_Object obj)
       if (!HASH_TABLE_P (Vprint_number_table))
 	Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq);
 
-      /* In case print-circle is nil and print-gensym is t,
-	 add OBJ to Vprint_number_table only when OBJ is a symbol.  */
-      if (! NILP (Vprint_circle) || SYMBOLP (obj))
-	{
-	  Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
-	  if (!NILP (num)
-	      /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
-		 always print the gensym with a number.  This is a special for
-		 the lisp function byte-compile-output-docform.  */
-	      || (!NILP (Vprint_continuous_numbering)
-		  && SYMBOLP (obj)
-		  && !SYMBOL_INTERNED_P (obj)))
-	    { /* OBJ appears more than once.	Let's remember that.  */
-	      if (!FIXNUMP (num))
-		{
-		  print_number_index++;
-		  /* Negative number indicates it hasn't been printed yet.  */
-		  Fputhash (obj, make_fixnum (- print_number_index),
-			    Vprint_number_table);
-		}
-	      print_depth--;
-	      return;
+      Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+      if (!NILP (num)
+	  /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+	     always print the gensym with a number.  This is a special for
+	     the lisp function byte-compile-output-docform.  */
+	  || (!NILP (Vprint_continuous_numbering)
+	      && SYMBOLP (obj)
+	      && !SYMBOL_INTERNED_P (obj)))
+	{ /* OBJ appears more than once.  Let's remember that.  */
+	  if (!FIXNUMP (num))
+	    {
+	      print_number_index++;
+	      /* Negative number indicates it hasn't been printed yet.  */
+	      Fputhash (obj, make_fixnum (- print_number_index),
+			Vprint_number_table);
 	    }
-	  else
-	    /* OBJ is not yet recorded.  Let's add to the table.  */
-	    Fputhash (obj, Qt, Vprint_number_table);
+	  print_depth--;
+	  return;
 	}
+      else
+	/* OBJ is not yet recorded.  Let's add to the table.  */
+	Fputhash (obj, Qt, Vprint_number_table);
 
       switch (XTYPE (obj))
 	{
@@ -1275,11 +1258,15 @@ print_preprocess (Lisp_Object obj)
 
 DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0,
        doc: /* Extract sharing info from OBJECT needed to print it.
-Fills `print-number-table'.  */)
-  (Lisp_Object object)
+Fills `print-number-table' if `print-circle' is non-nil.  Does nothing
+if `print-circle' is nil.  */)
+     (Lisp_Object object)
 {
-  print_number_index = 0;
-  print_preprocess (object);
+  if (!NILP (Vprint_circle))
+    {
+      print_number_index = 0;
+      print_preprocess (object);
+    }
   return Qnil;
 }
 
@@ -1864,7 +1851,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       /* Simple but incomplete way.  */
       int i;
 
-      /* See similar code in print_preprocess.  */
       if (print_depth >= PRINT_CIRCLE)
 	error ("Apparently circular structure being printed");
 
-- 
2.19.2

bug#36566: 27.0.50; debug is sometimes horribly slow

[Noam Postavsky]

Gemini Lasswell <gazally@runbox.com> writes:

>>> ...by modifying the logic in print_preprocess to not create a hash table
>>> if the top-level object is a string with no properties.
>>
>> This last idea sounds like a straightforward win to me, with no obvious
>> drawbacks.  I mean, no point in allocating a hash table if we can
>> cheaply detect it will never be used, right?
>
> I made that change, and then, in studying the uses of
> print-number-table, found more cases in which allocated hash tables were
> never used.  Since 2011 when byte-compile-disable-print-circle was
> marked obsolete and 2012 when commit 4ae29f89be changed the logic in
> print_object, the only time print-number-table gets used is when
> print-circle is non-nil.

> Michael's use case is down to 0.7s on my machine.

> Subject: [PATCH 2/5] Improve performance of backtrace printing (bug#36566)
>
> * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
> print-level and print-length more quickly when the structure being
> printed is very large.

Is this one still needed?  I tried reverting it, and it seems to make no
noticeable difference now (I didn't really measure though, I can't think
of a straightforward way of doing that), at least for the case that
Michael posted.

> Subject: [PATCH 4/5] Create common tests for print.c and cl-print.el
>
> * test/lisp/emacs-lisp/cl-print-tests.el:
                                          ^
Extra colon.

> (cl-print--test, cl-print-tests-1, cl-print-tests-2)
> (cl-print-tests-3, cl-print-tests-4, cl-print-tests-5)
> (cl-print-tests-strings, cl-print-circle, cl-print-circle-2):
> Remove.

> Subject: [PATCH 5/5] Don't build print-number-table unless it will be used
>
> There are only a few users of print-number-table, and none of them use
> it when print-circle is nil.  A couple of them used to.  print_object
> was changed to not use print-number-table unless print-circle is non-nil
> in commit 4ae29f89be.  byte-compile-output-docform which uses[...]

We try not to use hashes to reference commits (e.g., so that ChangeLogs
can be read without accessing the git repo).  I prefer date+subject, as
in

    There are only a few users of print-number-table, and none of them use
    it when print-circle is nil.  A couple of them used to.  print_object
    was changed in 2012-04-20 "* src/print.c (print_preprocess): Only check
    print_depth if print-circle is nil".  byte-compile-output-docform which
    uses[...]

You can also use "Action Stamps" though I find those not so human-readable
(theoretically, it's more machine-readable).

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Noam Postavsky <npostavs@gmail.com> writes:

>> Subject: [PATCH 2/5] Improve performance of backtrace printing (bug#36566)
>>
>> * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
>> print-level and print-length more quickly when the structure being
>> printed is very large.
>
> Is this one still needed?  I tried reverting it, and it seems to make no
> noticeable difference now (I didn't really measure though, I can't think
> of a straightforward way of doing that), at least for the case that
> Michael posted.

My straightforward way of doing that is

M-: (benchmark-run (revert-buffer))  RET

while the backtrace buffer is current.

I tried, with and without the patch, these steps:

Navigate to org-export--prune-tree in ox.el.
C-M-x to instrument it with Edebug.
Open a 150K org-mode file.
C-c C-e h H
Edebug to line 2728 of ox.el (inside the lambda bound to 'walk-data').
Use 'd' to get a backtrace. 
M-: (benchmark-run (revert-buffer)) RET

With the patch: (0.594630583 9 0.31395808699999783)
Without the patch: (0.925387816 15 0.5158638049999986)

I would expect that debugging deeper into org-mode export (so that there
are more frames to display containing the org parse tree) with a larger
org-mode file would exaggerate the difference.

Edebug is very sluggish debugging org-export--prune-tree because it is
sending some 400K lines to the echo area, and then those make *Messages*
redisplay slow.  I will work on another patch to improve Edebug's
behavior in this case.

>> Subject: [PATCH 4/5] Create common tests for print.c and cl-print.el
>
> Extra colon.
>
>> Subject: [PATCH 5/5] Don't build print-number-table unless it will be used
>
> We try not to use hashes to reference commits
>

I'll fix the patch comments as you suggest.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Noam Postavsky]

Gemini Lasswell <gazally@runbox.com> writes:

> Noam Postavsky <npostavs@gmail.com> writes:
>
>>> Subject: [PATCH 2/5] Improve performance of backtrace printing (bug#36566)
>>>
>>> * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
>>> print-level and print-length more quickly when the structure being
>>> printed is very large.
>>
>> Is this one still needed?  I tried reverting it, and it seems to make no
>> noticeable difference now (I didn't really measure though, I can't think
>> of a straightforward way of doing that), at least for the case that
>> Michael posted.
>
> My straightforward way of doing that is
>
> M-: (benchmark-run (revert-buffer))  RET
>
> while the backtrace buffer is current.

I actually get 0.9 vs 1.3 seconds (the latter being with patch 2/5
reverted) with Michael's example, which is more of a difference than I
expected based on my non-timed trials.

> I tried, with and without the patch, these steps:
>
> Navigate to org-export--prune-tree in ox.el.
> C-M-x to instrument it with Edebug.
> Open a 150K org-mode file.
> C-c C-e h H
> Edebug to line 2728 of ox.el (inside the lambda bound to 'walk-data').
> Use 'd' to get a backtrace. 
> M-: (benchmark-run (revert-buffer)) RET
>
> With the patch: (0.594630583 9 0.31395808699999783)
> Without the patch: (0.925387816 15 0.5158638049999986)
>
> I would expect that debugging deeper into org-mode export (so that there
> are more frames to display containing the org parse tree) with a larger
> org-mode file would exaggerate the difference.

Alright, it's probably enough to justify this.

> Edebug is very sluggish debugging org-export--prune-tree because it is
> sending some 400K lines to the echo area, and then those make *Messages*
> redisplay slow.  I will work on another patch to improve Edebug's
> behavior in this case.
>
>>> Subject: [PATCH 4/5] Create common tests for print.c and cl-print.el
>>
>> Extra colon.
>>
>>> Subject: [PATCH 5/5] Don't build print-number-table unless it will be used
>>
>> We try not to use hashes to reference commits
>>
>
> I'll fix the patch comments as you suggest.

Okay, there's nothing more from my side, so I guess you can go ahead and
push when ready.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Noam Postavsky <npostavs@gmail.com> writes:

>
> Okay, there's nothing more from my side, so I guess you can go ahead and
> push when ready.

Pushed.  I'll leave this bug open for the remaining performance problem
in Edebug.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Mauro Aranda]

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

After commit 6eaf39d21b70802e6bc607ee2fc2fff67b79231a
Fix unnecessary hash table creation in cl-prin1 (bug#36566)

I can't build emacs with configure option
--enable-check-lisp-object-type.

This is the compilation error I get:
  CC       print.o
print.c: In function ‘print_preprocess’:
print.c:1155:4: error: invalid operands to binary || (have ‘int’ and
‘Lisp_Object {aka struct Lisp_Object}’)
    || Vprint_continuous_numbering))     \
    ^
print.c:1188:7: note: in expansion of macro ‘PRINT_CIRCLE_CANDIDATE_P’
   if (PRINT_CIRCLE_CANDIDATE_P (obj))
       ^
print.c: In function ‘print_object’:
print.c:1155:4: error: invalid operands to binary || (have ‘int’ and
‘Lisp_Object {aka struct Lisp_Object}’)
    || Vprint_continuous_numbering))     \
    ^
print.c:1866:12: note: in expansion of macro ‘PRINT_CIRCLE_CANDIDATE_P’
   else if (PRINT_CIRCLE_CANDIDATE_P (obj))
            ^
Makefile:402: recipe for target 'print.o' failed
make[1]: *** [print.o] Error 1
make[1]: Leaving directory '/home/tbb/emacs/emacs/src'
Makefile:424: recipe for target 'src' failed
make: *** [src] Error 2

However, using plain ./configure && make
builds succesfully.

Previous commit builds, using the same option.
I add system information, as output by `report-emacs-bug':

In GNU Emacs 27.0.50 (build 4, i686-pc-linux-gnu, GTK+ Version 3.18.9)
 of 2019-09-14 built on the-blackbeard
Repository revision: 5c40c21a47062782bc983f41e8eeb97180dca693
Repository branch: HEAD
Windowing system distributor 'The X.Org Foundation', version 11.0.11906000
System Description: Ubuntu 16.04.6 LTS

Configured using:
 'configure --enable-check-lisp-object-type'

[-- Attachment #2: Type: text/html, Size: 1949 bytes --]

bug#36566: 27.0.50; debug is sometimes horribly slow

[Eli Zaretskii]

> From: Mauro Aranda <maurooaranda@gmail.com>
> Date: Sat, 14 Sep 2019 10:44:23 -0300
> Cc: Michael Heerdegen <michael_heerdegen@web.de>, 36566@debbugs.gnu.org,
>  Noam Postavsky <npostavs@gmail.com>, Stefan Monnier <monnier@iro.umontreal.ca>
> 
> After commit 6eaf39d21b70802e6bc607ee2fc2fff67b79231a
> Fix unnecessary hash table creation in cl-prin1 (bug#36566)
> 
> I can't build emacs with configure option
> --enable-check-lisp-object-type.
> 
> This is the compilation error I get:
>   CC       print.o
> print.c: In function ‘print_preprocess’:
> print.c:1155:4: error: invalid operands to binary || (have ‘int’ and ‘Lisp_Object {aka struct Lisp_Object}’)
>     || Vprint_continuous_numbering))     \
>     ^

Thanks.  Please try again, I think I fixed this.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Mauro Aranda]

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

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Mauro Aranda <maurooaranda@gmail.com>
>> Date: Sat, 14 Sep 2019 10:44:23 -0300
>> Cc: Michael Heerdegen <michael_heerdegen@web.de>, 36566@debbugs.gnu.org,
>>  Noam Postavsky <npostavs@gmail.com>, Stefan Monnier <
monnier@iro.umontreal.ca>
>>
>> After commit 6eaf39d21b70802e6bc607ee2fc2fff67b79231a
>> Fix unnecessary hash table creation in cl-prin1 (bug#36566)
>>
>> I can't build emacs with configure option
>> --enable-check-lisp-object-type.
>>
>> This is the compilation error I get:
>>   CC       print.o
>> print.c: In function ‘print_preprocess’:
>> print.c:1155:4: error: invalid operands to binary || (have ‘int’ and
‘Lisp_Object {aka struct Lisp_Object}’)
>>     || Vprint_continuous_numbering))     \
>>     ^
>
> Thanks.  Please try again, I think I fixed this.

Builds succesfully now.  Thank you.

[-- Attachment #2: Type: text/html, Size: 1369 bytes --]

bug#36566: 27.0.50; debug is sometimes horribly slow

[Eli Zaretskii]

> From: Mauro Aranda <maurooaranda@gmail.com>
> Date: Sat, 14 Sep 2019 11:16:04 -0300
> Cc: Gemini Lasswell <gazally@runbox.com>, Michael Heerdegen <michael_heerdegen@web.de>, 36566@debbugs.gnu.org, 
> 	Noam Postavsky <npostavs@gmail.com>, Stefan Monnier <monnier@iro.umontreal.ca>
> 
> >>   CC       print.o
> >> print.c: In function ‘print_preprocess’:
> >> print.c:1155:4: error: invalid operands to binary || (have ‘int’ and ‘Lisp_Object {aka struct Lisp_Object}’)
> >>     || Vprint_continuous_numbering))     \
> >>     ^
> >
> > Thanks.  Please try again, I think I fixed this.
> 
> Builds succesfully now.  Thank you.

Great, thanks for testing.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Gemini Lasswell <gazally@runbox.com> writes:

> Pushed.  I'll leave this bug open for the remaining performance problem
> in Edebug.

(I'm going through old bug reports that unfortunately weren't resolved
at the time.)

Skimming this bug report, it's not immediately clear to me what the
remaining performance problems were.  Does anybody have a simple test
case that illustrates the problem (if, indeed, it's still present in the
current Emacs -- this was two years ago).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Skimming this bug report, it's not immediately clear to me what the
> remaining performance problems were.  Does anybody have a simple test
> case that illustrates the problem (if, indeed, it's still present in the
> current Emacs -- this was two years ago).

I didn't see performance problems with my setup since then AFAIR.
Didn't play much with the newly introduced debugger settings and
commands though.

Let's wait for Gemini's answer.

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Skimming this bug report, it's not immediately clear to me what the
> remaining performance problems were.  Does anybody have a simple test
> case that illustrates the problem (if, indeed, it's still present in the
> current Emacs -- this was two years ago).

I followed these steps, found in one of my emails from two years ago,
using Emacs 28 downloaded from my distro and launched with '-Q', and a
bigger org file of about 250K, cause that's what I had handy:

Navigate to org-export--prune-tree in ox.el.
C-M-x to instrument it with Edebug.
Open a 150K org-mode file.
C-c C-e h H
Press Space repeatedly to step with Edebug

Result: stepping over any evaluation of the variable  `data` takes a few
seconds.

Two years ago I called Edebug "very sluggish" in these circumstances but
I would not call it that today, so I think you can go ahead and close
this.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Gemini Lasswell <gazally@runbox.com> writes:

> Press Space repeatedly to step with Edebug

When I replied I missed that the report partly diverged into Edebug (my
original report was about the backtrace based debugger).

> Result: stepping over any evaluation of the variable  `data` takes a few
> seconds.

Is that time spent in printing?  I experience that from time to time,
too, but I thought it might be related to my config.  Should we maybe
create a new report for that and close this one?

Thanks,

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Michael Heerdegen <michael_heerdegen@web.de> writes:

>> Result: stepping over any evaluation of the variable  `data` takes a few
>> seconds.
>
> Is that time spent in printing?  I experience that from time to time,
> too, but I thought it might be related to my config.  Should we maybe
> create a new report for that and close this one?

Yup, sounds good to me, so I'm closing this one.

A case to reproduce the problem that doesn't require org files would be
nice.  `data' in the example here is a parse tree, so perhaps the
slowness is in printing tree-like structures?  (But I haven't actually
tried to debug this.)

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Gemini Lasswell]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> A case to reproduce the problem that doesn't require org files would be
> nice.  `data' in the example here is a parse tree, so perhaps the
> slowness is in printing tree-like structures?  (But I haven't actually
> tried to debug this.)

The slowness does come from printing large tree-like structures. Here is
a small example to reproduce the problem.  Paste the following code into
*scratch*:

(defun my-make-a-tree (depth)
  (if (natnump depth)
      (list (my-make-a-tree (1- depth)) (my-make-a-tree (1- depth)))
    (list 'leaf)))

(defun my-func ()
  (let ((tree (my-make-a-tree 13)))
    tree))

(my-func)

Evaluate the first form using C-M-x and the second using C-u C-M-x.
Then evaluate the third form with C-M-x.  You will enter Edebug; press
space to step through.

Result: Each step takes a few seconds and creates a message of about
150K characters.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Gemini Lasswell <gazally@runbox.com> writes:

> The slowness does come from printing large tree-like structures. Here is
> a small example to reproduce the problem.  Paste the following code into
> *scratch*:
>
> (defun my-make-a-tree (depth)
>   (if (natnump depth)
>       (list (my-make-a-tree (1- depth)) (my-make-a-tree (1- depth)))
>     (list 'leaf)))
>
> (defun my-func ()
>   (let ((tree (my-make-a-tree 13)))
>     tree))
>
> (my-func)
>
> Evaluate the first form using C-M-x and the second using C-u C-M-x.
> Then evaluate the third form with C-M-x.  You will enter Edebug; press
> space to step through.
>
> Result: Each step takes a few seconds and creates a message of about
> 150K characters.

Thanks for the recipe; I can reproduce the issue here, too.  I'm not
quite sure what the correct shortening would be here...  anybody got any
ideas?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Thanks for the recipe; I can reproduce the issue here, too.  I'm not
> quite sure what the correct shortening would be here...  anybody got any
> ideas?

Changing `edebug-print-level' helps... Maybe the default is too
large?

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> Changing `edebug-print-level' helps... Maybe the default is too
> large?

Changing it to 20 doesn't seem to have much effect, but at 10, things
are pretty speedy.  The problem then is that the output is all dots:

Result: ((((((((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...)))) ((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...))))) (((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...)))) ((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...)))))) ((((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...)))) ((((... ...) (... ...)) ((... ...) (... ...))) (((... ...) (... ...)) ((... ...) (... ...))))) (((((... ...) (... ...)) ((... ...) (... ...))) (((... 

It goes on like that for 6K.

I suspect that we need a better algorithm for identifying and dealing
with tree structures.  That is, if we determine that we're not really
printing a list, but a tree (that shouldn't be too difficult,
statistically), then edebug could flip a printing switch and do this...
differently.

(Hand-wavey details left as an exercise for the reader.) 

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> Changing `edebug-print-level' helps... Maybe the default is too
>> large?
> Changing it to 20 doesn't seem to have much effect, but at 10, things
> are pretty speedy.  The problem then is that the output is all dots:

How 'bout using a `print-char-length` limit after which we truncate?
The truncation could "respect trees" in the sense that we'd truncate

    (((a b c) (d e f) (g h k)))

to something like

    (((a b c) (d e ...) ...))

rather than to

    (((a b c) (d e ...

if the `print-char-length` is 14.

I suspect that with such a limit we should eliminate "all" performance
issues, because printing should then have a complexity
O(print-char-length) rather than O(sizeof(object)), except for the
`print--preprocess` part which would still be O(sizeof(object)), but
since that one is all written in C (and performs a lot less work) the
constant is such much lower that it rarely dominates.


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

> How 'bout using a `print-char-length` limit after which we truncate?
> The truncation could "respect trees" in the sense that we'd truncate
>
>     (((a b c) (d e f) (g h k)))
>
> to something like
>
>     (((a b c) (d e ...) ...))
>
> rather than to
>
>     (((a b c) (d e ...
>
> if the `print-char-length` is 14.
>
> I suspect that with such a limit we should eliminate "all" performance
> issues, because printing should then have a complexity
> O(print-char-length) rather than O(sizeof(object)), except for the
> `print--preprocess` part which would still be O(sizeof(object)), but
> since that one is all written in C (and performs a lot less work) the
> constant is such much lower that it rarely dominates.

Hm...  that sounds really attractive, I think.  I'm trying to think of
any circumstances I'd rather see the current print-length algo instead
of this one, and I'm coming up blank.  😀

The only issue is "oh no, not yet another printing variable" (that
people will be setting to 14 in ~/.emacs and then everything that does
`prin1' to write out data will fail).

I did suggest (in conjunction with another bug report in this area) that
we should just extend `prin1{,-to-string}' with a parameter that would
set (on the C level) an equivalent variable.  So we'd have
(prin1 object fun `((char-length . ,edebug-print-char-length)))
etc.  (And `t' would be "all defaults".)

Perhaps I should just implement that stuff first.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> The only issue is "oh no, not yet another printing variable" (that
> people will be setting to 14 in ~/.emacs and then everything that does
> `prin1' to write out data will fail).

As someone requested long ago, we should have some way to "reset" the
printing config context in a single step without having to mention
individually each and every var.

But maybe for this specific issue we could make it so
`print-char-length` is only obeyed by `cl-print` (and only when
`cl-print-readably` is nil) and not `prin1` (which is the function that
prints in a machine-readable way and should hence arguably never
truncate).

> I did suggest (in conjunction with another bug report in this area) that
> we should just extend `prin1{,-to-string}' with a parameter that would
> set (on the C level) an equivalent variable.  So we'd have
> (prin1 object fun `((char-length . ,edebug-print-char-length)))
> etc.  (And `t' would be "all defaults".)

Some kind of "print context" object would be good, indeed.
Being able to set/modify this context "at a distance" via dynamic
scoping is quite handy, tho, so we probably want to still support that
as well.

Here's an idea: a print context could include an `inherit` setting which
says whether to "keep looking for more settings from the context".
Then we printing we use settings from:
- the explicit context passed as arg (if present).
- the currently existing `print-<foo>` vars (if there isn't an explicit
  context arg whose `inherit` says not to do that).
We could even go crazy and add an intermediate step to check
a `print-context` var which contains such an object.


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

> But maybe for this specific issue we could make it so
> `print-char-length` is only obeyed by `cl-print` (and only when
> `cl-print-readably` is nil) and not `prin1` (which is the function that
> prints in a machine-readable way and should hence arguably never
> truncate).

Ah, yes, that's true...  it's not really that big a deal with the new
variable if we do it that way.

>> I did suggest (in conjunction with another bug report in this area) that
>> we should just extend `prin1{,-to-string}' with a parameter that would
>> set (on the C level) an equivalent variable.  So we'd have
>> (prin1 object fun `((char-length . ,edebug-print-char-length)))
>> etc.  (And `t' would be "all defaults".)
>
> Some kind of "print context" object would be good, indeed.
> Being able to set/modify this context "at a distance" via dynamic
> scoping is quite handy, tho, so we probably want to still support that
> as well.
>
> Here's an idea: a print context could include an `inherit` setting which
> says whether to "keep looking for more settings from the context".
> Then we printing we use settings from:
> - the explicit context passed as arg (if present).
> - the currently existing `print-<foo>` vars (if there isn't an explicit
>   context arg whose `inherit` says not to do that).
> We could even go crazy and add an intermediate step to check
> a `print-context` var which contains such an object.

I was thinking something along the lines of

(prin1 object nil '((depth . 4) (circle . t)))

to "bind" only those two, and t as a special value for "all the
defaults" (i.e., print-length/depth/etc to nil), but you can also mix
and match:

(prin1 object nil '(t (depth . 4) (circle . t)))

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> I was thinking something along the lines of
>
> (prin1 object nil '((depth . 4) (circle . t)))

OK, I've now done a rough implementation:

(let ((print-length 10))
  (prin1 (make-list 20 t) (current-buffer) t)
  nil)
(t t t t t t t t t t t t t t t t t t t t)

(let ((print-length 10))
  (prin1 (make-list 20 t) (current-buffer) '((length . 5)))
  nil)
(t t t t t ...)

Don't have time for more today, but I think this has promise.  And this
means that we can introduce more printer settings without introducing
more global dynamic variables.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> Don't have time for more today, but I think this has promise.  And this
> means that we can introduce more printer settings without introducing
> more global dynamic variables.

Not sure how to do it for `cl-print`, tho.  I suspect we'll end up
having to use dynamic vars internally otherwise it'll break the existing
signature of `cl-print-object` (we can't so easily add an optional arg
to a generic function).


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

> Not sure how to do it for `cl-print`, tho.  I suspect we'll end up
> having to use dynamic vars internally otherwise it'll break the existing
> signature of `cl-print-object` (we can't so easily add an optional arg
> to a generic function).

Yes.

But this reminds me -- why do we have `cl-print' anyway?  Shouldn't the
C version handle printing things nicely?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

I've now finished the implementation and pushed to the trunk.  It's not
really that relevant to this discussion since we're using cl-prin1
anyway, but anyway.

I wondered whether to keep the mapping variable all on the C side.  I
marked print--variable-mapping as a constant, but somebody may just
setcdr it anyway, so it's not really constant in any meaningful way, and
users shouldn't modify it.  But I thought it might be vaguely useful to
be able to inspect that variable so that it's less mysterious what's
happening.

But writing this, I think I'm changing my mind, and I think I may remove
that DEFVAR_LISP...  Hm.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Lars Ingebrigtsen [2022-05-15 14:25:09] wrote:
> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> Not sure how to do it for `cl-print`, tho.  I suspect we'll end up
>> having to use dynamic vars internally otherwise it'll break the existing
>> signature of `cl-print-object` (we can't so easily add an optional arg
>> to a generic function).
> Yes.
> But this reminds me -- why do we have `cl-print' anyway?

Because we want to let packages use `cl-defmethod` to provide their own
output syntax for their objects.

> Shouldn't the C version handle printing things nicely?

The C code doesn't really know about cl-defstructs (or advice objects).


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

>> But this reminds me -- why do we have `cl-print' anyway?
>
> Because we want to let packages use `cl-defmethod` to provide their own
> output syntax for their objects.
>
>> Shouldn't the C version handle printing things nicely?
>
> The C code doesn't really know about cl-defstructs (or advice objects).

Wouldn't it make sense to teach the C `prin1' about those (and also call
out to the Lisp level for the objects that have a specialised print
syntax)?  We've got something vaguely similar with
`print-unreadable-function', for instance.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Lars Ingebrigtsen [2022-05-15 18:25:11] wrote:
> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>>> But this reminds me -- why do we have `cl-print' anyway?
>> Because we want to let packages use `cl-defmethod` to provide their own
>> output syntax for their objects.
>>> Shouldn't the C version handle printing things nicely?
>> The C code doesn't really know about cl-defstructs (or advice objects).
> Wouldn't it make sense to teach the C `prin1' about those (and also call
> out to the Lisp level for the objects that have a specialised print
> syntax)?

Maybe it would.  I tend to think we should focus the C code on printing
data quickly and in a `read`able way (i.e. in sync with `lread.c`) and
benefit from the comfort of ELisp for the implementation of the
human-readable version of the printout where performance is not as
important because we will truncate long outputs anyway.

> We've got something vaguely similar with `print-unreadable-function',
> for instance.

This var is bound to the notion of `read`able, not "human readable",
which is why it belong in the C code (because sadly not everything can
be printed in a `read`able way).


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

> Maybe it would.  I tend to think we should focus the C code on printing
> data quickly and in a `read`able way (i.e. in sync with `lread.c`) and
> benefit from the comfort of ELisp for the implementation of the
> human-readable version of the printout where performance is not as
> important because we will truncate long outputs anyway.

Well, OK...  but why does edebug use cl-prin1 then when stepping through
code?  Stepping through code should be fast, and we don't really care
that much about the prettiness of the values were displaying then.

Using cl-prin1 would is fine in `edebug-eval-expression' etc, but I
don't quite see the point when stepping?

So if we use prin1 when stepping, we could implement `char-length'
purely as an OVERRIDE element, and not do that in cl-prin1.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Michael Heerdegen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Well, OK...  but why does edebug use cl-prin1 then when stepping through
> code?  Stepping through code should be fast, and we don't really care
> that much about the prettiness of the values were displaying then.
>
> Using cl-prin1 would is fine in `edebug-eval-expression' etc, but I
> don't quite see the point when stepping?

Especially in stepping I don't want to see the inwards, I want a
representation that is easy to grasp.

Michael.

bug#36566: 27.0.50; debug is sometimes horribly slow

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Lars Ingebrigtsen [2022-05-16 03:00:45] wrote:
> Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> Maybe it would.  I tend to think we should focus the C code on printing
>> data quickly and in a `read`able way (i.e. in sync with `lread.c`) and
>> benefit from the comfort of ELisp for the implementation of the
>> human-readable version of the printout where performance is not as
>> important because we will truncate long outputs anyway.
> Well, OK...  but why does edebug use cl-prin1 then when stepping through
> code?

Because what is printed is intended to be read by a human rather than by `read`.

> Stepping through code should be fast, and we don't really care
> that much about the prettiness of the values were displaying then.

I think we do care to see closures printed in a human-understandable
way, for example.

And with a `char-length` constraint the output should always be fast.


        Stefan

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

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

>> Stepping through code should be fast, and we don't really care
>> that much about the prettiness of the values were displaying then.
>
> I think we do care to see closures printed in a human-understandable
> way, for example.
>
> And with a `char-length` constraint the output should always be fast.

Well, OK.  cl-prin1 could have its own Lisp variable for this, I
guess -- cl-print-char-length.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#36566: 27.0.50; debug is sometimes horribly slow

[Rudolf Schlatte]

Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:

>> The only issue is "oh no, not yet another printing variable" (that
>> people will be setting to 14 in ~/.emacs and then everything that does
>> `prin1' to write out data will fail).
>
> As someone requested long ago, we should have some way to "reset" the
> printing config context in a single step without having to mention
> individually each and every var.

Common Lisp uses with-standard-io-syntax for this purpose
(http://clhs.lisp.se/Body/m_w_std_.htm).

bug#36566: 27.0.50; debug is sometimes horribly slow

[Lars Ingebrigtsen]

Rudolf Schlatte <rudi@constantly.at> writes:

>> As someone requested long ago, we should have some way to "reset" the
>> printing config context in a single step without having to mention
>> individually each and every var.
>
> Common Lisp uses with-standard-io-syntax for this purpose
> (http://clhs.lisp.se/Body/m_w_std_.htm).

That would be OK, but doesn't help with the "setting non Lisp world
variables", and a parameter gives us both of these things.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no