build_marker histogram

8 files changed, 37 insertions, 23 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 09b51ba2a08..5ee1b37e292 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4167,11 +4167,14 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
 /* Return a newly allocated marker which points into BUF
    at character position CHARPOS and byte position BYTEPOS.  */
 
+static int build_marker_counts[100] = {0};
+
 Lisp_Object
-build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
+build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos, int where)
 {
   /* No dead buffers here.  */
   eassert (BUFFER_LIVE_P (buf));
+  build_marker_counts[where] += 1;
 
   /* Every character is at least one byte.  */
   eassert (charpos <= bytepos);
@@ -4371,6 +4374,16 @@ FUNCTION.  FUNCTION will be run once per finalizer object.  */)
   return make_lisp_ptr (finalizer, Lisp_Vectorlike);
 }
 
+DEFUN ("build-marker-counts", Fbuild_marker_counts, Sbuild_marker_counts, 0, 0,
+       0, doc: /* */)
+  (void)
+{
+  Lisp_Object v = Fmake_vector (make_fixnum (30), Qnil);
+  for (int i = 0; i < 30; ++i)
+    ASET (v, i, make_int (build_marker_counts[i]));
+  return v;
+}
+
 
 /************************************************************************
                          Mark bit access functions
@@ -8555,7 +8568,8 @@ N should be nonnegative.  */);
   defsubr (&Sgarbage_collect_maybe);
   defsubr (&Smemory_info);
   defsubr (&Smemory_use_counts);
-#if defined GNU_LINUX && defined __GLIBC__ && \
+  defsubr (&Sbuild_marker_counts);
+#if defined GNU_LINUX && defined __GLIBC__ &&   \
   (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10)
 
   defsubr (&Smalloc_info);
diff --git a/src/buffer.c b/src/buffer.c
index 09423e8592a..640cf33ea17 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -736,7 +736,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to)
         {
           struct Lisp_Marker *m = XMARKER (obj);
 
-          obj = build_marker (to, m->charpos, m->bytepos);
+          obj = build_marker (to, m->charpos, m->bytepos, 9);
           XMARKER (obj)->insertion_type = m->insertion_type;
         }
 
@@ -902,15 +902,15 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil.  */)
 
       bset_pt_marker (b->base_buffer,
                       build_marker (b->base_buffer, b->base_buffer->pt,
-                                    b->base_buffer->pt_byte));
+                                    b->base_buffer->pt_byte, 13));
 
       bset_begv_marker (b->base_buffer,
                         build_marker (b->base_buffer, b->base_buffer->begv,
-                                      b->base_buffer->begv_byte));
+                                      b->base_buffer->begv_byte, 14));
 
       bset_zv_marker (b->base_buffer,
                       build_marker (b->base_buffer, b->base_buffer->zv,
-                                    b->base_buffer->zv_byte));
+                                    b->base_buffer->zv_byte, 15));
 
       XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1;
     }
@@ -918,9 +918,9 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil.  */)
   if (NILP (clone))
     {
       /* Give the indirect buffer markers for its narrowing.  */
-      bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte));
-      bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte));
-      bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte));
+      bset_pt_marker (b, build_marker (b, b->pt, b->pt_byte, 17));
+      bset_begv_marker (b, build_marker (b, b->begv, b->begv_byte, 18));
+      bset_zv_marker (b, build_marker (b, b->zv, b->zv_byte, 19));
       XMARKER (BVAR (b, zv_marker))->insertion_type = 1;
     }
   else
diff --git a/src/composite.c b/src/composite.c
index ca007f9971d..2256e0254fc 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -982,7 +982,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
       /* Save point as marker before calling out to lisp.  */
       if (NILP (string))
         record_unwind_protect (restore_point_unwind,
-                               build_marker (current_buffer, pt, pt_byte));
+                               build_marker (current_buffer, pt, pt_byte, 8));
       lgstring = safe_calln (Vauto_composition_function, AREF (rule, 2),
                             pos, make_fixnum (to), font_object, string,
                             direction);
diff --git a/src/editfns.c b/src/editfns.c
index 74c7d54086b..0b7c4cff66a 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -199,7 +199,7 @@ DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
        doc: /* Return value of point, as a marker object.  */)
   (void)
 {
-  return build_marker (current_buffer, PT, PT_BYTE);
+  return build_marker (current_buffer, PT, PT_BYTE, 10);
 }
 
 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1,
@@ -889,7 +889,7 @@ DEFUN ("point-min-marker", Fpoint_min_marker, Spoint_min_marker, 0, 0, 0,
 This is the beginning, unless narrowing (a buffer restriction) is in effect.  */)
   (void)
 {
-  return build_marker (current_buffer, BEGV, BEGV_BYTE);
+  return build_marker (current_buffer, BEGV, BEGV_BYTE, 11);
 }
 
 DEFUN ("point-max", Fpoint_max, Spoint_max, 0, 0, 0,
@@ -909,7 +909,7 @@ This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
 is in effect, in which case it is less.  */)
   (void)
 {
-  return build_marker (current_buffer, ZV, ZV_BYTE);
+  return build_marker (current_buffer, ZV, ZV_BYTE, 12);
 }
 
 DEFUN ("gap-position", Fgap_position, Sgap_position, 0, 0, 0,
@@ -3009,8 +3009,8 @@ save_restriction_save_1 (void)
     {
       Lisp_Object beg, end;
 
-      beg = build_marker (current_buffer, BEGV, BEGV_BYTE);
-      end = build_marker (current_buffer, ZV, ZV_BYTE);
+      beg = build_marker (current_buffer, BEGV, BEGV_BYTE, 20);
+      end = build_marker (current_buffer, ZV, ZV_BYTE, 21);
 
       /* END must move forward if text is inserted at its exact location.  */
       XMARKER (end)->insertion_type = 1;
diff --git a/src/lisp.h b/src/lisp.h
index 912b208a213..aaa7b6c4aeb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -5146,7 +5146,7 @@ extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object)
 extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
 extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
                                                ptrdiff_t, ptrdiff_t);
-extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t);
+extern Lisp_Object build_marker (struct buffer *, ptrdiff_t, ptrdiff_t, int);
 extern void syms_of_marker (void);
 
 /* Defined in fileio.c.  */
diff --git a/src/marker.c b/src/marker.c
index 3290917b268..8b22474f2bb 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -236,7 +236,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
          cache the correspondence by creating a marker here.
          It will last until the next GC.  */
       if (record)
-        build_marker (b, best_below, best_below_byte);
+        build_marker (b, best_below, best_below_byte, 4);
 
       byte_char_debug_check (b, best_below, best_below_byte);
 
@@ -261,7 +261,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
          cache the correspondence by creating a marker here.
          It will last until the next GC.  */
       if (record)
-        build_marker (b, best_above, best_above_byte);
+        build_marker (b, best_above, best_above_byte, 5);
 
       byte_char_debug_check (b, best_above, best_above_byte);
 
@@ -389,7 +389,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
          But don't do it if BUF_MARKERS is nil;
          that is a signal from Fset_buffer_multibyte.  */
       if (record && BUF_MARKERS (b))
-        build_marker (b, best_below, best_below_byte);
+        build_marker (b, best_below, best_below_byte, 6);
 
       byte_char_debug_check (b, best_below, best_below_byte);
 
@@ -417,10 +417,10 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
          that is a signal from Fset_buffer_multibyte.  */
 #ifdef HAVE_MPS
       if (record && VECTORP (BUF_MARKERS (b)))
-        build_marker (b, best_above, best_above_byte);
+        build_marker (b, best_above, best_above_byte, 7);
 #else
       if (record && BUF_MARKERS (b))
-        build_marker (b, best_above, best_above_byte);
+        build_marker (b, best_above, best_above_byte, 7);
 #endif
       byte_char_debug_check (b, best_above, best_above_byte);
 
diff --git a/src/window.c b/src/window.c
index 70472749e74..8fd059631ac 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7774,7 +7774,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i)
           if (EQ (window, selected_window))
             p->pointm = build_marker (XBUFFER (w->contents),
                                       BUF_PT (XBUFFER (w->contents)),
-                                      BUF_PT_BYTE (XBUFFER (w->contents)));
+                                      BUF_PT_BYTE (XBUFFER (w->contents)), 1);
           else
             p->pointm = Fcopy_marker (w->pointm, Qnil);
           p->old_pointm = Fcopy_marker (w->old_pointm, Qnil);
diff --git a/src/xdisp.c b/src/xdisp.c
index 07dd33bbd80..2bfc22fd15f 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -13621,7 +13621,7 @@ format_mode_line_unwind_data (struct frame *target_frame,
          unwinding (Bug#32777).  */
       ASET (vector, 10, buffer);
       current_buffer = b;
-      ASET (vector, 11, build_marker (current_buffer, PT, PT_BYTE));
+      ASET (vector, 11, build_marker (current_buffer, PT, PT_BYTE, 2));
       current_buffer = cb;
     }