commit 53a1a29bec4d19b4a5ecc66f532bb3cc289b1869 (HEAD, refs/remotes/origin/master)
Author: Eli Zaretskii <eliz@gnu.org>
Date:   Sat Sep 14 11:21:40 2019 +0300

    ; * etc/NEWS: Fix last change.

diff --git a/etc/NEWS b/etc/NEWS
index d3338bf57d..94c98a7ebe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1375,6 +1375,7 @@ the Elisp manual for documentation of the new mode and its commands.
 dimensions, instead of always using 16 pixels.  As a result, Tetris,
 Snake and Pong are more playable on HiDPI displays.
 
+---
 *** 'gamegrid-add-score' can now sort scores from lower to higher.
 This is useful for games where lower scores are better, like time-based games.
 

commit 36bf5534bf9034860ee6ffda94fa71d4eec8a671
Author: Federico Tedin <federicotedin@gmail.com>
Date:   Wed Sep 4 00:18:11 2019 +0200

    Allow gamegrid-add-score to treat lower scores as better.
    
    * lisp/play/gamegrid.el (gamegrid-add-score): Add 'reverse' parameter.
    (gamegrid-add-score-with-update-game-score): Add 'reverse' parameter.
    (gamegrid-add-score-with-update-game-score-1): Add 'reverse'
    parameter.  Pass on "-r" argument to update-game-score.
    (gamegrid-add-score-insecure): Add 'reverse' parameter, reverse scores
    when it's non-nil.  (Bug#36867)
    
    * etc/NEWS: Announce the change.

diff --git a/etc/NEWS b/etc/NEWS
index 1bde9c442b..d3338bf57d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1375,6 +1375,9 @@ the Elisp manual for documentation of the new mode and its commands.
 dimensions, instead of always using 16 pixels.  As a result, Tetris,
 Snake and Pong are more playable on HiDPI displays.
 
+*** 'gamegrid-add-score' can now sort scores from lower to higher.
+This is useful for games where lower scores are better, like time-based games.
+
 ** Filecache
 
 ---
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index be09a73a1f..df9b135248 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -505,9 +505,12 @@ format."
 
 ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun gamegrid-add-score (file score)
+(defun gamegrid-add-score (file score &optional reverse)
   "Add the current score to the high score file.
 
+If REVERSE is non-nil, treat lower scores as better than higher
+scores. This is useful for games where lower scores are better.
+
 On POSIX systems there may be a shared game directory for all users in
 which the scorefiles are kept.  On such systems Emacs doesn't create
 the score file FILE in this directory, if it doesn't already exist.
@@ -525,9 +528,9 @@ specified by the variable `temporary-file-directory'.  If necessary,
 FILE is created there."
   (pcase system-type
     ((or 'ms-dos 'windows-nt)
-     (gamegrid-add-score-insecure file score))
+     (gamegrid-add-score-insecure file score reverse))
     (_
-     (gamegrid-add-score-with-update-game-score file score))))
+     (gamegrid-add-score-with-update-game-score file score reverse))))
 
 
 ;; On POSIX systems there are four cases to distinguish:
@@ -556,20 +559,21 @@ FILE is created there."
 
 (defvar gamegrid-shared-game-dir)
 
-(defun gamegrid-add-score-with-update-game-score (file score)
+(defun gamegrid-add-score-with-update-game-score (file score &optional reverse)
   (let* ((update-game-score-modes
 	  (file-modes (expand-file-name "update-game-score" exec-directory)))
 	 (gamegrid-shared-game-dir
 	  (not (zerop (logand #o6000 (or update-game-score-modes 0))))))
     (cond ((or (not update-game-score-modes) (file-name-absolute-p file))
 	   (gamegrid-add-score-insecure file score
-                                        gamegrid-user-score-file-directory))
+                                        gamegrid-user-score-file-directory
+                                        reverse))
 	  ((and gamegrid-shared-game-dir
 		(file-exists-p (expand-file-name file shared-game-score-directory)))
 	   ;; Use the setgid (or setuid) "update-game-score" program
 	   ;; to update a system-wide score file.
 	   (gamegrid-add-score-with-update-game-score-1 file
-	    (expand-file-name file shared-game-score-directory) score))
+	    (expand-file-name file shared-game-score-directory) score reverse))
 	  ;; Else: Add the score to a score file in the user's home
 	  ;; directory.
 	  (gamegrid-shared-game-dir
@@ -579,7 +583,8 @@ FILE is created there."
 		    (directory-file-name gamegrid-user-score-file-directory))
 	     (make-directory gamegrid-user-score-file-directory t))
 	   (gamegrid-add-score-insecure file score
-					gamegrid-user-score-file-directory))
+					gamegrid-user-score-file-directory
+                                        reverse))
 	  (t
 	   (unless (file-exists-p
 		    (directory-file-name gamegrid-user-score-file-directory))
@@ -588,9 +593,9 @@ FILE is created there."
 				      gamegrid-user-score-file-directory)))
 	     (unless (file-exists-p f)
 	       (write-region "" nil f nil 'silent nil 'excl))
-	     (gamegrid-add-score-with-update-game-score-1 file f score))))))
+	     (gamegrid-add-score-with-update-game-score-1 file f score reverse))))))
 
-(defun gamegrid-add-score-with-update-game-score-1 (file target score)
+(defun gamegrid-add-score-with-update-game-score-1 (file target score &optional reverse)
   (let ((default-directory "/")
 	(errbuf (generate-new-buffer " *update-game-score loss*"))
         (marker-string (concat
@@ -601,17 +606,16 @@ FILE is created there."
     (with-local-quit
       (apply
        'call-process
-       (append
-	(list
-	 (expand-file-name "update-game-score" exec-directory)
-	 nil errbuf nil
-	 "-m" (int-to-string gamegrid-score-file-length)
-	 "-d" (if gamegrid-shared-game-dir
-		  (expand-file-name shared-game-score-directory)
-		(file-name-directory target))
-	 file
-	 (int-to-string score)
-	 marker-string))))
+       `(,(expand-file-name "update-game-score" exec-directory)
+         nil ,errbuf nil
+         "-m" ,(int-to-string gamegrid-score-file-length)
+         "-d" ,(if gamegrid-shared-game-dir
+                   (expand-file-name shared-game-score-directory)
+                 (file-name-directory target))
+         ,@(if reverse '("-r"))
+         ,file
+         ,(int-to-string score)
+         ,marker-string)))
     (if (buffer-modified-p errbuf)
 	(progn
 	  (display-buffer errbuf)
@@ -632,7 +636,7 @@ FILE is created there."
 				marker-string) nil t)
         (beginning-of-line)))))
 
-(defun gamegrid-add-score-insecure (file score &optional directory)
+(defun gamegrid-add-score-insecure (file score &optional directory reverse)
   (save-excursion
     (setq file (expand-file-name file (or directory
 					  temporary-file-directory)))
@@ -645,7 +649,8 @@ FILE is created there."
 		    (user-full-name)
 		    user-mail-address))
     (sort-fields 1 (point-min) (point-max))
-    (reverse-region (point-min) (point-max))
+    (unless reverse
+      (reverse-region (point-min) (point-max)))
     (goto-char (point-min))
     (forward-line gamegrid-score-file-length)
     (delete-region (point) (point-max))

commit bac66302e92bdd3a353102d2076548e7e83d92e5
Author: Paul Eggert <eggert@cs.ucla.edu>
Date:   Sat Sep 14 00:32:01 2019 -0700

    Improve gc-cons-percentage calculation
    
    The old calculation relied on a hodgpodge of partly updated GC
    stats to find a number to multiply gc-cons-percentage by.
    The new one counts data found by the previous GC, plus half of
    the data allocated since then; this is more systematic albeit
    still ad hoc.
    * src/alloc.c (consing_until_gc, gc_threshold, consing_threshold):
    Now EMACS_INT, not intmax_t.
    (HI_THRESHOLD): New macro.
    (tally_consing): New function.
    (make_interval, allocate_string, allocate_string_data)
    (make_float, free_cons, allocate_vectorlike, Fmake_symbol): Use it.
    (allow_garbage_collection, inhibit_garbage_collection)
    (consing_threshold, garbage_collect):
    Use HI_THRESHOLD rather than INTMAX_MAX.
    (consing_threshold): New arg SINCE_GC.  All callers changed.
    (bump_consing_until_gc): Return new consing_until_gc, instead of
    nil.  All callers changed.  Don’t worry about overflow since we
    now saturate at HI_THRESHOLD.  Guess that half of
    recently-allocated objects are still alive, instead of relying on
    the previous (even less-accurate) hodgepodge.
    (maybe_garbage_collect): New function.
    (garbage_collect): Work even if a finalizer disables or enables
    memory profiling.  Do not use malloc_probe if GC reclaimed nothing.
    * src/lisp.h (maybe_gc): Call maybe_garbage_collect instead
    of garbage_collect.

diff --git a/src/alloc.c b/src/alloc.c
index ca8311cc00..497f600551 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -224,7 +224,7 @@ struct emacs_globals globals;
 
 /* maybe_gc collects garbage if this goes negative.  */
 
-intmax_t consing_until_gc;
+EMACS_INT consing_until_gc;
 
 #ifdef HAVE_PDUMPER
 /* Number of finalizers run: used to loop over GC until we stop
@@ -238,9 +238,16 @@ bool gc_in_progress;
 
 /* System byte and object counts reported by GC.  */
 
+/* Assume byte counts fit in uintptr_t and object counts fit into
+   intptr_t.  */
 typedef uintptr_t byte_ct;
 typedef intptr_t object_ct;
 
+/* Large-magnitude value for a threshold count, which fits in EMACS_INT.
+   Using only half the EMACS_INT range avoids overflow hassles.
+   There is no need to fit these counts into fixnums.  */
+#define HI_THRESHOLD (EMACS_INT_MAX / 2)
+
 /* Number of live and free conses etc. counted by the most-recent GC.  */
 
 static struct gcstat
@@ -299,7 +306,7 @@ static intptr_t garbage_collection_inhibited;
 
 /* The GC threshold in bytes, the last time it was calculated
    from gc-cons-threshold and gc-cons-percentage.  */
-static intmax_t gc_threshold;
+static EMACS_INT gc_threshold;
 
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */
@@ -536,6 +543,15 @@ XFLOAT_INIT (Lisp_Object f, double n)
   XFLOAT (f)->u.data = n;
 }
 
+/* Account for allocation of NBYTES in the heap.  This is a separate
+   function to avoid hassles with implementation-defined conversion
+   from unsigned to signed types.  */
+static void
+tally_consing (ptrdiff_t nbytes)
+{
+  consing_until_gc -= nbytes;
+}
+
 #ifdef DOUG_LEA_MALLOC
 static bool
 pointers_fit_in_lispobj_p (void)
@@ -1372,7 +1388,7 @@ make_interval (void)
 
   MALLOC_UNBLOCK_INPUT;
 
-  consing_until_gc -= sizeof (struct interval);
+  tally_consing (sizeof (struct interval));
   intervals_consed++;
   RESET_INTERVAL (val);
   val->gcmarkbit = 0;
@@ -1739,7 +1755,7 @@ allocate_string (void)
   MALLOC_UNBLOCK_INPUT;
 
   ++strings_consed;
-  consing_until_gc -= sizeof *s;
+  tally_consing (sizeof *s);
 
 #ifdef GC_CHECK_STRING_BYTES
   if (!noninteractive)
@@ -1859,7 +1875,7 @@ allocate_string_data (struct Lisp_String *s,
       old_data->string = NULL;
     }
 
-  consing_until_gc -= needed;
+  tally_consing (needed);
 }
 
 
@@ -2464,7 +2480,7 @@ make_float (double float_value)
 
   XFLOAT_INIT (val, float_value);
   eassert (!XFLOAT_MARKED_P (XFLOAT (val)));
-  consing_until_gc -= sizeof (struct Lisp_Float);
+  tally_consing (sizeof (struct Lisp_Float));
   floats_consed++;
   return val;
 }
@@ -2535,8 +2551,8 @@ free_cons (struct Lisp_Cons *ptr)
   ptr->u.s.u.chain = cons_free_list;
   ptr->u.s.car = dead_object ();
   cons_free_list = ptr;
-  if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc))
-    consing_until_gc = INTMAX_MAX;
+  ptrdiff_t nbytes = sizeof *ptr;
+  tally_consing (-nbytes);
 }
 
 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -3153,7 +3169,7 @@ allocate_vectorlike (ptrdiff_t len)
   if (find_suspicious_object_in_range (p, (char *) p + nbytes))
     emacs_abort ();
 
-  consing_until_gc -= nbytes;
+  tally_consing (nbytes);
   vector_cells_consed += len;
 
   MALLOC_UNBLOCK_INPUT;
@@ -3438,7 +3454,7 @@ Its value is void, and its function definition and property list are nil.  */)
   MALLOC_UNBLOCK_INPUT;
 
   init_symbol (val, name);
-  consing_until_gc -= sizeof (struct Lisp_Symbol);
+  tally_consing (sizeof (struct Lisp_Symbol));
   symbols_consed++;
   return val;
 }
@@ -5477,7 +5493,7 @@ staticpro (Lisp_Object const *varaddress)
 static void
 allow_garbage_collection (intmax_t consing)
 {
-  consing_until_gc = consing - (INTMAX_MAX - consing_until_gc);
+  consing_until_gc = consing - (HI_THRESHOLD - consing_until_gc);
   garbage_collection_inhibited--;
 }
 
@@ -5487,7 +5503,7 @@ inhibit_garbage_collection (void)
   ptrdiff_t count = SPECPDL_INDEX ();
   record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc);
   garbage_collection_inhibited++;
-  consing_until_gc = INTMAX_MAX;
+  consing_until_gc = HI_THRESHOLD;
   return count;
 }
 
@@ -5761,11 +5777,13 @@ mark_and_sweep_weak_table_contents (void)
     }
 }
 
-/* Return the number of bytes to cons between GCs, assuming
-   gc-cons-threshold is THRESHOLD and gc-cons-percentage is
-   PERCENTAGE.  */
-static intmax_t
-consing_threshold (intmax_t threshold, Lisp_Object percentage)
+/* Return the number of bytes to cons between GCs, given THRESHOLD and
+   PERCENTAGE.  When calculating a threshold based on PERCENTAGE,
+   assume SINCE_GC bytes have been allocated since the most recent GC.
+   The returned value is positive and no greater than HI_THRESHOLD.  */
+static EMACS_INT
+consing_threshold (intmax_t threshold, Lisp_Object percentage,
+		   intmax_t since_gc)
 {
   if (!NILP (Vmemory_full))
     return memory_full_cons_threshold;
@@ -5775,42 +5793,33 @@ consing_threshold (intmax_t threshold, Lisp_Object percentage)
       if (FLOATP (percentage))
 	{
 	  double tot = (XFLOAT_DATA (percentage)
-			* total_bytes_of_live_objects ());
+			* (total_bytes_of_live_objects () + since_gc));
 	  if (threshold < tot)
 	    {
-	      if (tot < INTMAX_MAX)
-		threshold = tot;
+	      if (tot < HI_THRESHOLD)
+		return tot;
 	      else
-		threshold = INTMAX_MAX;
+		return HI_THRESHOLD;
 	    }
 	}
-      return threshold;
+      return min (threshold, HI_THRESHOLD);
     }
 }
 
-/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and
-   gc-cons-percentage is PERCENTAGE.  */
-static Lisp_Object
+/* Adjust consing_until_gc and gc_threshold, given THRESHOLD and PERCENTAGE.
+   Return the updated consing_until_gc.  */
+
+static EMACS_INT
 bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
 {
-  /* If consing_until_gc is negative leave it alone, since this prevents
-     negative integer overflow and a GC would have been done soon anyway.  */
-  if (0 <= consing_until_gc)
-    {
-      threshold = consing_threshold (threshold, percentage);
-      intmax_t sum;
-      if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum))
-	{
-	  /* Scale the threshold down so that consing_until_gc does
-	     not overflow.  */
-	  sum = INTMAX_MAX;
-	  threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
-	}
-      consing_until_gc = sum;
-      gc_threshold = threshold;
-    }
-
-  return Qnil;
+  /* Guesstimate that half the bytes allocated since the most
+     recent GC are still in use.  */
+  EMACS_INT since_gc = (gc_threshold - consing_until_gc) >> 1;
+  EMACS_INT new_gc_threshold = consing_threshold (threshold, percentage,
+						  since_gc);
+  consing_until_gc += new_gc_threshold - gc_threshold;
+  gc_threshold = new_gc_threshold;
+  return consing_until_gc;
 }
 
 /* Watch changes to gc-cons-threshold.  */
@@ -5821,7 +5830,8 @@ watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
   intmax_t threshold;
   if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
     return Qnil;
-  return bump_consing_until_gc (threshold, Vgc_cons_percentage);
+  bump_consing_until_gc (threshold, Vgc_cons_percentage);
+  return Qnil;
 }
 
 /* Watch changes to gc-cons-percentage.  */
@@ -5829,7 +5839,18 @@ static Lisp_Object
 watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
 			  Lisp_Object operation, Lisp_Object where)
 {
-  return bump_consing_until_gc (gc_cons_threshold, newval);
+  bump_consing_until_gc (gc_cons_threshold, newval);
+  return Qnil;
+}
+
+/* It may be time to collect garbage.  Recalculate consing_until_gc,
+   since it might depend on current usage, and do the garbage
+   collection if the recalculation says so.  */
+void
+maybe_garbage_collect (void)
+{
+  if (bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage) < 0)
+    garbage_collect ();
 }
 
 /* Subroutine of Fgarbage_collect that does most of the work.  */
@@ -5841,7 +5862,6 @@ garbage_collect (void)
   bool message_p;
   ptrdiff_t count = SPECPDL_INDEX ();
   struct timespec start;
-  byte_ct tot_before = 0;
 
   eassert (weak_hash_tables == NULL);
 
@@ -5856,14 +5876,15 @@ garbage_collect (void)
   FOR_EACH_BUFFER (nextb)
     compact_buffer (nextb);
 
-  if (profiler_memory_running)
-    tot_before = total_bytes_of_live_objects ();
+  byte_ct tot_before = (profiler_memory_running
+			? total_bytes_of_live_objects ()
+			: (byte_ct) -1);
 
   start = current_timespec ();
 
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
-  consing_until_gc = INTMAX_MAX;
+  consing_until_gc = HI_THRESHOLD;
 
   /* Save what's currently displayed in the echo area.  Don't do that
      if we are GC'ing because we've run out of memory, since
@@ -5975,7 +5996,7 @@ garbage_collect (void)
   unblock_input ();
 
   consing_until_gc = gc_threshold
-    = consing_threshold (gc_cons_threshold, Vgc_cons_percentage);
+    = consing_threshold (gc_cons_threshold, Vgc_cons_percentage, 0);
 
   if (garbage_collection_messages && NILP (Vmemory_full))
     {
@@ -6008,11 +6029,11 @@ garbage_collect (void)
   gcs_done++;
 
   /* Collect profiling data.  */
-  if (profiler_memory_running)
+  if (tot_before != (byte_ct) -1)
     {
       byte_ct tot_after = total_bytes_of_live_objects ();
-      byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after;
-      malloc_probe (min (swept, SIZE_MAX));
+      if (tot_after < tot_before)
+	malloc_probe (min (tot_before - tot_after, SIZE_MAX));
     }
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 024e5edb26..02f8a7b668 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3824,9 +3824,10 @@ extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
 extern void mark_stack (char const *, char const *);
 extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
 extern void garbage_collect (void);
+extern void maybe_garbage_collect (void);
 extern const char *pending_malloc_warning;
 extern Lisp_Object zero_vector;
-extern intmax_t consing_until_gc;
+extern EMACS_INT consing_until_gc;
 #ifdef HAVE_PDUMPER
 extern int number_finalizers_run;
 #endif
@@ -5056,7 +5057,7 @@ INLINE void
 maybe_gc (void)
 {
   if (consing_until_gc < 0)
-    garbage_collect ();
+    maybe_garbage_collect ();
 }
 
 INLINE_HEADER_END

commit e4fb98b542c57fa4856fbeb14230ace34d910117
Author: Paul Eggert <eggert@cs.ucla.edu>
Date:   Fri Sep 13 16:09:48 2019 -0700

    Simplify GC statistics-gathering
    
    * src/alloc.c (make_interval, allocate_string, make_float)
    (free_cons, Fcons, setup_on_free_list)
    (allocate_vector_from_block, Fmake_symbol):
    Do not update gcstat, since it is for statistics from the most
    recent GC, not for a partially-updated hodgepodge.
    (sweep_vectors): Update gcstat, since setup_on_free_list
    no longer does.
    (garbage_collect_1): Rename to garbage_collect and adopt its API.
    Remove the old garbage_collect, which is no longer needed.
    All callers changed.

diff --git a/src/alloc.c b/src/alloc.c
index 2d490f3bb7..ca8311cc00 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -241,7 +241,7 @@ bool gc_in_progress;
 typedef uintptr_t byte_ct;
 typedef intptr_t object_ct;
 
-/* Number of live and free conses etc.  */
+/* Number of live and free conses etc. counted by the most-recent GC.  */
 
 static struct gcstat
 {
@@ -560,7 +560,7 @@ struct Lisp_Finalizer finalizers;
 
 /* Head of a circularly-linked list of finalizers that must be invoked
    because we deemed them unreachable.  This list must be global, and
-   not a local inside garbage_collect_1, in case we GC again while
+   not a local inside garbage_collect, in case we GC again while
    running finalizers.  */
 struct Lisp_Finalizer doomed_finalizers;
 
@@ -1366,7 +1366,6 @@ make_interval (void)
 	  newi->next = interval_block;
 	  interval_block = newi;
 	  interval_block_index = 0;
-	  gcstat.total_free_intervals += INTERVAL_BLOCK_SIZE;
 	}
       val = &interval_block->intervals[interval_block_index++];
     }
@@ -1375,7 +1374,6 @@ make_interval (void)
 
   consing_until_gc -= sizeof (struct interval);
   intervals_consed++;
-  gcstat.total_free_intervals--;
   RESET_INTERVAL (val);
   val->gcmarkbit = 0;
   return val;
@@ -1730,8 +1728,6 @@ allocate_string (void)
 	  NEXT_FREE_LISP_STRING (s) = string_free_list;
 	  string_free_list = ptr_bounds_clip (s, sizeof *s);
 	}
-
-      gcstat.total_free_strings += STRING_BLOCK_SIZE;
     }
 
   check_string_free_list ();
@@ -1742,8 +1738,6 @@ allocate_string (void)
 
   MALLOC_UNBLOCK_INPUT;
 
-  gcstat.total_free_strings--;
-  gcstat.total_strings++;
   ++strings_consed;
   consing_until_gc -= sizeof *s;
 
@@ -2461,7 +2455,6 @@ make_float (double float_value)
 	  memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
 	  float_block = new;
 	  float_block_index = 0;
-	  gcstat.total_free_floats += FLOAT_BLOCK_SIZE;
 	}
       XSETFLOAT (val, &float_block->floats[float_block_index]);
       float_block_index++;
@@ -2473,7 +2466,6 @@ make_float (double float_value)
   eassert (!XFLOAT_MARKED_P (XFLOAT (val)));
   consing_until_gc -= sizeof (struct Lisp_Float);
   floats_consed++;
-  gcstat.total_free_floats--;
   return val;
 }
 
@@ -2545,7 +2537,6 @@ free_cons (struct Lisp_Cons *ptr)
   cons_free_list = ptr;
   if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc))
     consing_until_gc = INTMAX_MAX;
-  gcstat.total_free_conses++;
 }
 
 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
@@ -2565,26 +2556,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
     {
       if (cons_block_index == CONS_BLOCK_SIZE)
 	{
-	  /* Maximum number of conses that should be active at any
-	     given time, so that list lengths fit into a ptrdiff_t and
-	     into a fixnum.  */
-	  ptrdiff_t max_conses = min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM);
-
-	  /* This check is typically optimized away, as a runtime
-	     check is needed only on weird platforms where a count of
-	     distinct conses might not fit.  */
-	  if (max_conses < INTPTR_MAX / sizeof (struct Lisp_Cons)
-	      && (max_conses - CONS_BLOCK_SIZE
-		  < gcstat.total_free_conses + gcstat.total_conses))
-	    memory_full (sizeof (struct cons_block));
-
 	  struct cons_block *new
 	    = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
 	  memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
 	  new->next = cons_block;
 	  cons_block = new;
 	  cons_block_index = 0;
-	  gcstat.total_free_conses += CONS_BLOCK_SIZE;
 	}
       XSETCONS (val, &cons_block->conses[cons_block_index]);
       cons_block_index++;
@@ -2596,7 +2573,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
   XSETCDR (val, cdr);
   eassert (!XCONS_MARKED_P (XCONS (val)));
   consing_until_gc -= sizeof (struct Lisp_Cons);
-  gcstat.total_free_conses--;
   cons_cells_consed++;
   return val;
 }
@@ -2855,7 +2831,6 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
   eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
   set_next_vector (v, vector_free_lists[vindex]);
   vector_free_lists[vindex] = v;
-  gcstat.total_free_vector_slots += nbytes / word_size;
 }
 
 /* Get a new vector block.  */
@@ -2903,7 +2878,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
     {
       vector = vector_free_lists[index];
       vector_free_lists[index] = next_vector (vector);
-      gcstat.total_free_vector_slots -= nbytes / word_size;
       return vector;
     }
 
@@ -2917,7 +2891,6 @@ allocate_vector_from_block (ptrdiff_t nbytes)
 	/* This vector is larger than requested.  */
 	vector = vector_free_lists[index];
 	vector_free_lists[index] = next_vector (vector);
-	gcstat.total_free_vector_slots -= nbytes / word_size;
 
 	/* Excess bytes are used for the smaller vector,
 	   which should be set on an appropriate free list.  */
@@ -3092,7 +3065,10 @@ sweep_vectors (void)
 		   space was coalesced into the only free vector.  */
 		free_this_block = true;
 	      else
-		setup_on_free_list (vector, total_bytes);
+		{
+		  setup_on_free_list (vector, total_bytes);
+		  gcstat.total_free_vector_slots += total_bytes / word_size;
+		}
 	    }
 	}
 
@@ -3454,7 +3430,6 @@ Its value is void, and its function definition and property list are nil.  */)
 	  new->next = symbol_block;
 	  symbol_block = new;
 	  symbol_block_index = 0;
-	  gcstat.total_free_symbols += SYMBOL_BLOCK_SIZE;
 	}
       XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
       symbol_block_index++;
@@ -3465,7 +3440,6 @@ Its value is void, and its function definition and property list are nil.  */)
   init_symbol (val, name);
   consing_until_gc -= sizeof (struct Lisp_Symbol);
   symbols_consed++;
-  gcstat.total_free_symbols--;
   return val;
 }
 
@@ -5723,7 +5697,7 @@ visit_buffer_root (struct gc_root_visitor visitor,
 
    There are other GC roots of course, but these roots are dynamic
    runtime data structures that pdump doesn't care about and so we can
-   continue to mark those directly in garbage_collect_1.  */
+   continue to mark those directly in garbage_collect.  */
 void
 visit_static_gc_roots (struct gc_root_visitor visitor)
 {
@@ -5753,8 +5727,7 @@ mark_object_root_visitor (Lisp_Object const *root_ptr,
 }
 
 /* List of weak hash tables we found during marking the Lisp heap.
-   Will be NULL on entry to garbage_collect_1 and after it
-   returns.  */
+   NULL on entry to garbage_collect and after it returns.  */
 static struct Lisp_Hash_Table *weak_hash_tables;
 
 NO_INLINE /* For better stack traces */
@@ -5860,8 +5833,8 @@ watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
 }
 
 /* Subroutine of Fgarbage_collect that does most of the work.  */
-static bool
-garbage_collect_1 (struct gcstat *gcst)
+void
+garbage_collect (void)
 {
   struct buffer *nextb;
   char stack_top_variable;
@@ -5873,7 +5846,7 @@ garbage_collect_1 (struct gcstat *gcst)
   eassert (weak_hash_tables == NULL);
 
   if (garbage_collection_inhibited)
-    return false;
+    return;
 
   /* Record this function, so it appears on the profiler's backtraces.  */
   record_in_backtrace (QAutomatic_GC, 0, 0);
@@ -6014,8 +5987,6 @@ garbage_collect_1 (struct gcstat *gcst)
 
   unbind_to (count, Qnil);
 
-  *gcst = gcstat;
-
   /* GC is complete: now we can run our finalizer callbacks.  */
   run_finalizers (&doomed_finalizers);
 
@@ -6043,15 +6014,6 @@ garbage_collect_1 (struct gcstat *gcst)
       byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after;
       malloc_probe (min (swept, SIZE_MAX));
     }
-
-  return true;
-}
-
-void
-garbage_collect (void)
-{
-  struct gcstat gcst;
-  garbage_collect_1 (&gcst);
 }
 
 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
@@ -6071,10 +6033,12 @@ returns nil, because real GC can't be done.
 See Info node `(elisp)Garbage Collection'.  */)
   (void)
 {
-  struct gcstat gcst;
-  if (!garbage_collect_1 (&gcst))
+  if (garbage_collection_inhibited)
     return Qnil;
 
+  garbage_collect ();
+  struct gcstat gcst = gcstat;
+
   Lisp_Object total[] = {
     list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
 	   make_int (gcst.total_conses),

commit 0dba340da54f129750096a5a8704805a94f5535c
Author: Gemini Lasswell <gazally@runbox.com>
Date:   Sat Aug 3 21:39:29 2019 -0700

    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 in 2012-04-20 "* src/print.c (print_preprocess): Only
    check print_depth if print-circle is nil".
    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.

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 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        && 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");
 

commit 3bd6ef40b55e429a321c87a09fd94e6ca0e50ae7
Author: Gemini Lasswell <gazally@runbox.com>
Date:   Sun Aug 4 15:56:12 2019 -0700

    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.

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 @@
     (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 @@ otherwise, use a different charset."
                        (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 @@ otherwise, use a different charset."
                     (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

commit 6eaf39d21b70802e6bc607ee2fc2fff67b79231a
Author: Gemini Lasswell <gazally@runbox.com>
Date:   Sat Aug 3 12:33:20 2019 -0700

    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.

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 @@ static ptrdiff_t print_buffer_pos_byte;
      -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) \

commit 5c40c21a47062782bc983f41e8eeb97180dca693
Author: Gemini Lasswell <gazally@runbox.com>
Date:   Tue Jul 30 11:56:51 2019 -0700

    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.

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

commit 2093395dbf8563af38f206950d95f0bc20183b9c
Author: Gemini Lasswell <gazally@runbox.com>
Date:   Tue Jul 30 10:00:27 2019 -0700

    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.

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 12caeaf128..71e767d0a6 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line.
 @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 @@ This should be a list of `backtrace-frame' objects.")
 
 (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 @@ frames where the source code location is known.")
     (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 @@ frames where the source code location is known.")
          :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 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'."
   `(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 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button."
 
 (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 @@ position point at the start of the frame it was in before."
           (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 @@ line contains the strings \"lambda\" and \"number\"."
       (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

commit 224534ab8d3f60fea28b271859f8eaf373f95089
Author: Stefan Kangas <stefankangas@gmail.com>
Date:   Mon Jul 1 08:45:24 2019 +0200

    * lisp/help-mode.el (help-mode-menu): Fix typo.  (Bug#36485)

diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index fb29bd2be4..efc0b8ffa9 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -59,7 +59,7 @@
     ["Next Topic" help-go-forward
      :help "Go back to next topic in this help buffer"]
     ["Move to Previous Button" backward-button
-     :help "Move to the Next Button in the help buffer"]
+     :help "Move to the Previous Button in the help buffer"]
     ["Move to Next Button" forward-button
       :help "Move to the Next Button in the help buffer"]))
 

commit 9ad3f5d1d26a672763fc289ecb7a8443ad564252
Author: Stefan Kangas <stefankangas@gmail.com>
Date:   Thu Aug 22 16:11:52 2019 +0200

    * doc/misc/efaq.texi: Update ancient formats. (Bug#37143)

diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index e5673daf3a..a591b88201 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -21,7 +21,7 @@ Copyright @copyright{} 1990, 1991, 1992 Joseph Brian Wells@*
 @quotation
 This list of frequently asked questions about GNU Emacs with answers
 (``FAQ'') may be translated into other languages, transformed into other
-formats (e.g., Texinfo, Info, WWW, WAIS), and updated with new information.
+formats (e.g., Texinfo, Info, HTML, PDF), and updated with new information.
 
 The same conditions apply to any derivative of the FAQ as apply to the FAQ
 itself.  Every copy of the FAQ must include this notice or an approved

commit 45b01f2d7fc9929fccf2e173291001ab04387947
Author: Stefan Kangas <stefankangas@gmail.com>
Date:   Fri Sep 13 18:06:31 2019 +0200

    Remove leftover XEmacs compat code and doc fixes
    
    * lisp/mail/feedmail.el (top-level): Remove outdated comment.
    (feedmail-run-the-queue): Remove leftover XEmacs compat code.
    (feedmail-nuke-bcc): Doc fix.
    
    * lisp/emulation/viper.el (top-level, viper-mode)
    * lisp/net/rfc2104.el (top-level): Doc fix.
    
    * lisp/textmodes/table.el (top-level): Remove obsolete todo.

diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 521edbe604..0f5c92c2c9 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1,4 +1,4 @@
-;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs,  -*-lexical-binding:t -*-
+;;; viper.el --- A full-featured Vi emulator for Emacs  -*- lexical-binding:t -*-
 ;;		 a VI Plan for Emacs Rescue,
 ;;		 and a venomous VI PERil.
 ;;		 Viper Is also a Package for Emacs Rebels.
@@ -34,7 +34,7 @@
 
 ;;; Commentary:
 
-;; Viper is a full-featured Vi emulator for Emacs and XEmacs.  It emulates and
+;; Viper is a full-featured Vi emulator for Emacs.  It emulates and
 ;; improves upon the standard features of Vi and, at the same time, allows
 ;; full access to all Emacs facilities.  Viper supports multiple undo,
 ;; file name completion, command, file, and search history and it extends
@@ -541,7 +541,7 @@ If Viper is enabled, turn it off.  Otherwise, turn it on."
 		      "Viper Is a Package for Emacs Rebels,
 a VI Plan for Emacs Rescue, and a venomous VI PERil.
 
-Incidentally, Viper emulates Vi under Emacs/XEmacs 20.
+Incidentally, Viper emulates Vi under Emacs.
 It supports all of what is good in Vi and Ex, while extending
 and improving upon much of it.
 
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index babc3fc212..b362614d3a 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -17,15 +17,6 @@
 ;; ability to queue messages for later sending.  This replaces
 ;; the standalone fakemail program that used to be distributed with Emacs.
 
-;; feedmail works with recent versions of Emacs (20.x series) and
-;; XEmacs (tested with 20.4 and later betas).  It probably no longer
-;; works with Emacs v18, though I haven't tried that in a long
-;; time.  Makoto.Nakagawa@jp.compaq.com reports: "I have a report
-;; that with a help of APEL library, feedmail works fine under emacs
-;; 19.28.  You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/.
-;; you need apel-10.2 or later to make feedmail work under emacs
-;; 19.28."
-
 ;; Sorry, no manual yet in this release.  Look for one with the next
 ;; release.  Or the one after that.  Or maybe later.
 
@@ -437,9 +428,7 @@ shuttled robotically onward."
 (defcustom feedmail-confirm-outgoing-timeout nil
   "If non-nil, a timeout in seconds at the send confirmation prompt.
 If a positive number, it's a timeout before sending.  If a negative
-number, it's a timeout before not sending.  This will not work if your
-version of Emacs doesn't include the function `y-or-n-p-with-timeout'
-\(e.g., some versions of XEmacs)."
+number, it's a timeout before not sending."
   :version "24.1"
   :group 'feedmail-misc
   :type '(choice (const nil) integer)
@@ -2004,9 +1993,7 @@ backup file names and the like)."
 	     ((feedmail-fqm-p blobby)
 	      (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
 	      (setq already-buffer
-		    (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
-			(find-buffer-visiting maybe-file)
-		      (get-file-buffer maybe-file)))
+		    (find-buffer-visiting maybe-file))
 	      (if (and already-buffer (buffer-modified-p already-buffer))
 		  (save-window-excursion
 		    (display-buffer (set-buffer already-buffer))
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index 5de8401d5b..fadc979bc1 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -37,8 +37,6 @@
 ;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
 ;; resulting hash length (16 for MD5, 20 for SHA).
 ;;
-;; Tested with Emacs 20.2 and XEmacs 20.3.
-;;
 ;; Test case reference: RFC 2202.
 
 ;;; History:
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 1f185e0f21..f684f4e4ca 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -567,10 +567,6 @@
 ;; Consider the use of `:box' face attribute under Emacs 21
 ;; Consider the use of `modification-hooks' text property instead of
 ;; rebinding the keymap
-;; Maybe provide complete XEmacs support in the future however the
-;; "extent" is the single largest obstacle lying ahead, read the
-;; document in Emacs info.
-;; (progn (require 'info) (Info-find-node "elisp" "Not Intervals"))
 ;;
 ;;
 ;; ---------------

commit 897540069fb09d091802046046daca821079aac5
Author: Stefan Kangas <stefankangas@gmail.com>
Date:   Fri Sep 13 14:53:41 2019 +0200

    Change gui--selection-value-internal comment into doc string
    
    * lisp/select.el (gui--selection-value-internal): Change comment into
    doc string.  (Bug#25528)

diff --git a/lisp/select.el b/lisp/select.el
index 59bcf7da66..334e10f41b 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -160,12 +160,11 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
 		      (const TEXT)))
   :group 'killing)
 
-;; Get a selection value of type TYPE by calling gui-get-selection with
-;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
-;; The return value is already decoded.  If gui-get-selection causes an
-;; error, this function return nil.
-
 (defun gui--selection-value-internal (type)
+  "Get a selection value of type TYPE.
+Call `gui-get-selection' with an appropriate DATA-TYPE argument
+decided by `x-select-request-type'.  The return value is already
+decoded.  If `gui-get-selection' signals an error, return nil."
   (let ((request-type (if (eq window-system 'x)
                           (or x-select-request-type
                               '(UTF8_STRING COMPOUND_TEXT STRING))

commit 8af6b3ef425bb1f74d8d32b92731d32b8600e745
Author: Michael Albinus <michael.albinus@gmx.de>
Date:   Fri Sep 13 14:33:06 2019 +0200

    ; Fix a typo by last commit

diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 3bee4115a6..72491b9980 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -628,7 +628,7 @@ Consider them as regular expressions if third arg REGEXP is true."
                                (shadow-parse-name file))))
                          (when shadow-debug
                            (message
-                            "shadow-shadows-of: %s %s %s"
+                            "shadow-shadows-of-1: %s %s %s"
                             file (shadow-parse-name file) realname))
 			 (mapcar
 			  (function

commit 89a63c9186da693a81773eeb65bb8b17a1721d5d
Author: Michael Albinus <michael.albinus@gmx.de>
Date:   Fri Sep 13 14:25:56 2019 +0200

    ; Add traces in shadowfile.el

diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 2778e58367..3bee4115a6 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -207,7 +207,7 @@ PREFIX."
 
 ;;; I use the term `site' to refer to a string which may be the
 ;;; cluster identification "/name:", a remote identification
-;;; "/method:user@host:", or "/system-name:' (the value of
+;;; "/method:user@host:", or "/system-name:" (the value of
 ;;; `shadow-system-name') for the location of local files.  All
 ;;; user-level commands should accept either.
 
@@ -607,6 +607,11 @@ and to are absolute file names."
 			canonical-file shadow-literal-groups nil)
 		       (shadow-shadows-of-1
 			canonical-file shadow-regexp-groups t)))))
+          (when shadow-debug
+            (message
+             "shadow-shadows-of: %s %s %s %s %s"
+             file (shadow-local-file file) shadow-homedir
+             absolute-file canonical-file))
 	(set (intern file shadow-hashtable) shadows))))
 
 (defun shadow-shadows-of-1 (file groups regexp)
@@ -621,6 +626,10 @@ Consider them as regular expressions if third arg REGEXP is true."
 		       (let ((realname
                               (tramp-file-name-localname
                                (shadow-parse-name file))))
+                         (when shadow-debug
+                           (message
+                            "shadow-shadows-of: %s %s %s"
+                            file (shadow-parse-name file) realname))
 			 (mapcar
 			  (function
 			   (lambda (x)
@@ -631,6 +640,11 @@ Consider them as regular expressions if third arg REGEXP is true."
 
 (defun shadow-add-to-todo ()
   "If current buffer has shadows, add them to the list needing to be copied."
+  (when shadow-debug
+    (message
+     "shadow-add-to-todo: %s %s"
+     (buffer-file-name (current-buffer))
+     (shadow-expand-file-name (buffer-file-name (current-buffer)))))
   (let ((shadows (shadow-shadows-of
 		  (shadow-expand-file-name
 		   (buffer-file-name (current-buffer))))))

commit 8806c196ab12a0805c5afce6ccc5a36e4911a6a3
Author: Michael Albinus <michael.albinus@gmx.de>
Date:   Fri Sep 13 12:08:34 2019 +0200

    Fix problems in tramp-test33-environment-variables
    
    * test/lisp/net/tramp-tests.el (tramp-test33-environment-variables):
    Use ${parameter:-word} construct.  Remove PS1 entry from
    "printenv" output.
    (tramp--test-check-files): Use "printenv".

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dd6b9edd00..1554d3b70b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4407,7 +4407,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 	      "foo"
 	      (funcall
 	       this-shell-command-to-string
-	       (format "echo -n ${%s:?bla}" envvar))))))
+	       (format "echo -n ${%s:-bla}" envvar))))))
 
       (unwind-protect
 	  ;; Set the empty value.
@@ -4419,7 +4419,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 	      "bla"
 	      (funcall
 	       this-shell-command-to-string
-	       (format "echo -n ${%s:?bla}" envvar))))
+	       (format "echo -n ${%s:-bla}" envvar))))
 	    ;; Variable is set.
 	    (should
 	     (string-match
@@ -4441,7 +4441,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 	      "foo"
 	      (funcall
 	       this-shell-command-to-string
-	       (format "echo -n ${%s:?bla}" envvar))))
+	       (format "echo -n ${%s:-bla}" envvar))))
 	    (let ((process-environment
 		   (cons envvar process-environment)))
 	      ;; Variable is unset.
@@ -4450,12 +4450,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 		"bla"
 		(funcall
 		 this-shell-command-to-string
-		 (format "echo -n ${%s:?bla}" envvar))))
+		 (format "echo -n ${%s:-bla}" envvar))))
 	      ;; Variable is unset.
 	      (should-not
 	       (string-match
 		(regexp-quote envvar)
-		(funcall this-shell-command-to-string "env")))))))))
+		;; We must remove PS1, the output is truncated otherwise.
+		(funcall
+		 this-shell-command-to-string "printenv | grep -v PS1")))))))))
 
 ;; This test is inspired by Bug#27009.
 (ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -5303,7 +5305,7 @@ This requires restrictions of file name syntax."
 		  ;; of process output.  So we unset it temporarily.
 		  (setenv "PS1")
 		  (with-temp-buffer
-		    (should (zerop (process-file "env" nil t nil)))
+		    (should (zerop (process-file "printenv" nil t nil)))
 		    (goto-char (point-min))
 		    (should
 		     (re-search-forward

commit d8c7bf6683a16b4830fc1de1af49c58cd6163269
Author: Michael Albinus <michael.albinus@gmx.de>
Date:   Fri Sep 13 12:08:02 2019 +0200

    Make recent Tramp patch work for tramp-archive.el
    
    * lisp/net/tramp.el (tramp-connectable-p): Make it work also for
    tramp-archive.el.

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8903d38d20..aefb84bb4e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2530,12 +2530,11 @@ not in completion mode."
 	  ((tramp-file-name-p vec-or-filename) vec-or-filename)
 	  ((tramp-tramp-file-p vec-or-filename)
 	   (tramp-dissect-file-name vec-or-filename)))))
-    (when vec
-      (or ;; We check this for the process related to
-	  ;; `tramp-buffer-name'; otherwise `start-file-process'
-	  ;; wouldn't run ever when `non-essential' is non-nil.
-	  (process-live-p (get-process (tramp-buffer-name vec)))
-	  (not (tramp-completion-mode-p))))))
+    (or ;; We check this for the process related to
+	;; `tramp-buffer-name'; otherwise `start-file-process'
+	;; wouldn't run ever when `non-essential' is non-nil.
+        (and vec (process-live-p (get-process (tramp-buffer-name vec))))
+	(not (tramp-completion-mode-p)))))
 
 ;; Method, host name and user name completion.
 ;; `tramp-completion-dissect-file-name' returns a list of