Re: Inefficient code in reftex-index.el

[storm@cua.dk (Kim F. Storm)]

storm@cua.dk (Kim F. Storm) writes:

>
> Which brings me to the suggestion that we add an optional arg to
> set-match-data like this:
>
>   (set-match-data list &optional destroy-markers)
>
> and change save-match-data to use it 
>
> (defmacro save-match-data (&rest body)
>   "Execute the BODY forms, restoring the global value of the match data.
> The value returned is the value of the last form in BODY."
>   ;; It is better not to use backquote here,
>   ;; because that makes a bootstrapping problem
>   ;; if you need to recompile all the Lisp files using interpreted code.
>   (declare (indent 0) (debug t))
>   (list 'let
> 	'((save-match-data-internal (match-data)))
> 	(list 'unwind-protect
> 	      (cons 'progn body)
> 	      '(set-match-data save-match-data-internal t))))

I made the change slightly different to avoid adding another arg to
Fset_match_data, which causes problems at C level.  Instead, if first
arg to match-data is 'evaporate', set-match-data will eventually free
markers on the resulting list...

Here is a patch to implement this, and use it at the C-level, 
and for save-match-data:

I don't know for sure, but emacs feels a tiny bit more responsive
with this change!


Index: src/composite.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/composite.c,v
retrieving revision 1.31
diff -c -r1.31 composite.c
*** src/composite.c	26 Dec 2003 11:39:22 -0000	1.31
--- src/composite.c	6 Jun 2005 22:19:14 -0000
***************
*** 628,634 ****
      }
  
    /* Preserve the match data.  */
!   record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
  
    /* If none of ASCII characters have composition functions, we can
       skip them quickly.  */
--- 628,634 ----
      }
  
    /* Preserve the match data.  */
!   record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
  
    /* If none of ASCII characters have composition functions, we can
       skip them quickly.  */
Index: src/eval.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/eval.c,v
retrieving revision 1.240
diff -c -r1.240 eval.c
*** src/eval.c	3 Jun 2005 23:02:21 -0000	1.240
--- src/eval.c	6 Jun 2005 22:19:15 -0000
***************
*** 1971,1977 ****
    GCPRO3 (fun, funname, fundef);
  
    /* Preserve the match data.  */
!   record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
  
    /* Value saved here is to be restored into Vautoload_queue.  */
    record_unwind_protect (un_autoload, Vautoload_queue);
--- 1971,1977 ----
    GCPRO3 (fun, funname, fundef);
  
    /* Preserve the match data.  */
!   record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
  
    /* Value saved here is to be restored into Vautoload_queue.  */
    record_unwind_protect (un_autoload, Vautoload_queue);
cvs diff: I know nothing about src/lisp.c
Index: src/macmenu.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/macmenu.c,v
retrieving revision 1.28
diff -c -r1.28 macmenu.c
*** src/macmenu.c	6 Jun 2005 20:24:13 -0000	1.28
--- src/macmenu.c	6 Jun 2005 22:19:15 -0000
***************
*** 1475,1481 ****
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
        if (NILP (Voverriding_local_map_menu_flag))
  	{
  	  specbind (Qoverriding_terminal_local_map, Qnil);
--- 1475,1481 ----
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
        if (NILP (Voverriding_local_map_menu_flag))
  	{
  	  specbind (Qoverriding_terminal_local_map, Qnil);
Index: src/search.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/search.c,v
retrieving revision 1.192
diff -c -r1.192 search.c
*** src/search.c	20 Apr 2005 07:21:47 -0000	1.192
--- src/search.c	6 Jun 2005 22:19:15 -0000
***************
*** 2751,2777 ****
  this case, and if the last match was in a buffer, the buffer will get
  stored as one additional element at the end of the list.
  
! If REUSE is a list, reuse it as part of the value.  If REUSE is long enough
! to hold all the values, and if INTEGERS is non-nil, no consing is done.
  
  Return value is undefined if the last search failed.  */)
!      (integers, reuse)
       Lisp_Object integers, reuse;
  {
    Lisp_Object tail, prev;
    Lisp_Object *data;
!   int i, len;
  
    if (NILP (last_thing_searched))
      return Qnil;
  
    prev = Qnil;
  
!   data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 1)
  				 * sizeof (Lisp_Object));
  
    len = 0;
!   for (i = 0; i < search_regs.num_regs; i++)
      {
        int start = search_regs.start[i];
        if (start >= 0)
--- 2751,2803 ----
  this case, and if the last match was in a buffer, the buffer will get
  stored as one additional element at the end of the list.
  
! If INTEGER is the symbol `evaporate', mark the returned list so that
! any markers on the list shall be automatically freed when passed to
! `set-match-data'.
! 
! If REUSE is a list, reuse it as part of the value.  If REUSE is long
! enough to hold all the values, and if INTEGERS is non-nil, no consing
! is done.
! Note: Any previous markers on the reuse list will be modified to point
! to nowhere.
  
  Return value is undefined if the last search failed.  */)
!     (integers, reuse)
       Lisp_Object integers, reuse;
  {
    Lisp_Object tail, prev;
    Lisp_Object *data;
!   int i, j, len;
  
    if (NILP (last_thing_searched))
      return Qnil;
  
    prev = Qnil;
  
!   for (tail = reuse; CONSP (tail); tail = XCDR (tail))
!     if (MARKERP (XCAR (tail)))
! 	{
! 	  unchain_marker (XMARKER (XCAR (tail)));
! 	  XSETCAR (tail, Qnil);
! 	}
! 
!   data = (Lisp_Object *) alloca ((2 * search_regs.num_regs + 2)
  				 * sizeof (Lisp_Object));
  
+   j = 0;
    len = 0;
! 
!   if (EQ (integers, Qevaporate))
!     {
!       if (BUFFERP (last_thing_searched))
! 	{
! 	  data[j++] = Qevaporate;
! 	  len++;
! 	}
!       integers = Qnil;
!     }
! 
!   for (i = 0; i < search_regs.num_regs; i++, j += 2)
      {
        int start = search_regs.start[i];
        if (start >= 0)
***************
*** 2779,2795 ****
  	  if (EQ (last_thing_searched, Qt)
  	      || ! NILP (integers))
  	    {
! 	      XSETFASTINT (data[2 * i], start);
! 	      XSETFASTINT (data[2 * i + 1], search_regs.end[i]);
  	    }
  	  else if (BUFFERP (last_thing_searched))
  	    {
! 	      data[2 * i] = Fmake_marker ();
! 	      Fset_marker (data[2 * i],
  			   make_number (start),
  			   last_thing_searched);
! 	      data[2 * i + 1] = Fmake_marker ();
! 	      Fset_marker (data[2 * i + 1],
  			   make_number (search_regs.end[i]),
  			   last_thing_searched);
  	    }
--- 2805,2821 ----
  	  if (EQ (last_thing_searched, Qt)
  	      || ! NILP (integers))
  	    {
! 	      XSETFASTINT (data[j], start);
! 	      XSETFASTINT (data[j + 1], search_regs.end[i]);
  	    }
  	  else if (BUFFERP (last_thing_searched))
  	    {
! 	      data[j] = Fmake_marker ();
! 	      Fset_marker (data[j],
  			   make_number (start),
  			   last_thing_searched);
! 	      data[j + 1] = Fmake_marker ();
! 	      Fset_marker (data[j + 1],
  			   make_number (search_regs.end[i]),
  			   last_thing_searched);
  	    }
***************
*** 2797,2806 ****
  	    /* last_thing_searched must always be Qt, a buffer, or Qnil.  */
  	    abort ();
  
! 	  len = 2*(i+1);
  	}
        else
! 	data[2 * i] = data [2 * i + 1] = Qnil;
      }
  
    if (BUFFERP (last_thing_searched) && !NILP (integers))
--- 2823,2832 ----
  	    /* last_thing_searched must always be Qt, a buffer, or Qnil.  */
  	    abort ();
  
! 	  len = j + 2;
  	}
        else
! 	data[j] = data[j + 1] = Qnil;
      }
  
    if (BUFFERP (last_thing_searched) && !NILP (integers))
***************
*** 2836,2847 ****
  
  DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 1, 0,
         doc: /* Set internal data on last search match from elements of LIST.
! LIST should have been created by calling `match-data' previously.  */)
!      (list)
       register Lisp_Object list;
  {
    register int i;
    register Lisp_Object marker;
  
    if (running_asynch_code)
      save_search_regs ();
--- 2862,2878 ----
  
  DEFUN ("set-match-data", Fset_match_data, Sset_match_data, 1, 1, 0,
         doc: /* Set internal data on last search match from elements of LIST.
! LIST should have been created by calling `match-data' previously.
! 
! If CLEAR-MARKERS is non-nil, make markers on the list point nowhere.
! If value is `evaporate', put the markers back on the free list; the
! caller must ensure that there are no other references to these markers.  */)
!     (list)
       register Lisp_Object list;
  {
    register int i;
    register Lisp_Object marker;
+   int free_markers = 0;
  
    if (running_asynch_code)
      save_search_regs ();
***************
*** 2853,2858 ****
--- 2884,2897 ----
       in LIST, assume that this match data came from a string.  */
    last_thing_searched = Qt;
  
+   /* If first element of list is `evaporate', free all markers
+      on the list after restoring search registers.  */
+   if (CONSP (list) && EQ (XCAR (list), Qevaporate))
+     {
+       free_markers = 1;
+       list = XCDR (list);
+     }
+ 
    /* Allocate registers if they don't already exist.  */
    {
      int length = XFASTINT (Flength (list)) / 2;
***************
*** 2882,2890 ****
  	search_regs.num_regs = length;
        }
  
!     for (i = 0;; i++)
        {
! 	marker = Fcar (list);
  	if (BUFFERP (marker))
  	  {
  	    last_thing_searched = marker;
--- 2921,2929 ----
  	search_regs.num_regs = length;
        }
  
!     for (i = 0; CONSP (list); i++)
        {
! 	marker = XCAR (list);
  	if (BUFFERP (marker))
  	  {
  	    last_thing_searched = marker;
***************
*** 2900,2906 ****
--- 2939,2947 ----
  	else
  	  {
  	    int from;
+ 	    Lisp_Object m;
  
+ 	    m = marker;
  	    if (MARKERP (marker))
  	      {
  		if (XMARKER (marker)->buffer == 0)
***************
*** 2911,2927 ****
  
  	    CHECK_NUMBER_COERCE_MARKER (marker);
  	    from = XINT (marker);
- 	    list = Fcdr (list);
  
! 	    marker = Fcar (list);
  	    if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
  	      XSETFASTINT (marker, 0);
  
  	    CHECK_NUMBER_COERCE_MARKER (marker);
  	    search_regs.start[i] = from;
  	    search_regs.end[i] = XINT (marker);
  	  }
! 	list = Fcdr (list);
        }
  
      for (; i < search_regs.num_regs; i++)
--- 2952,2985 ----
  
  	    CHECK_NUMBER_COERCE_MARKER (marker);
  	    from = XINT (marker);
  
! 	    if (free_markers && MARKERP (m))
! 	      {
! 		XSETCAR (list, Qnil);
! 		free_marker (m);
! 	      }
! 
! 	    list = XCDR (list);
! 
! 	    if (!CONSP (list))
! 	      break;
! 
! 	    m = marker = Fcar (list);
! 
  	    if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
  	      XSETFASTINT (marker, 0);
  
  	    CHECK_NUMBER_COERCE_MARKER (marker);
  	    search_regs.start[i] = from;
  	    search_regs.end[i] = XINT (marker);
+ 
+ 	    if (free_markers && MARKERP (m))
+ 	      {
+ 		XSETCAR (list, Qnil);
+ 		free_marker (m);
+ 	      }
  	  }
! 	list = XCDR (list);
        }
  
      for (; i < search_regs.num_regs; i++)
Index: src/w32menu.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/w32menu.c,v
retrieving revision 1.72
diff -c -r1.72 w32menu.c
*** src/w32menu.c	24 May 2005 08:44:25 -0000	1.72
--- src/w32menu.c	6 Jun 2005 22:19:15 -0000
***************
*** 1443,1449 ****
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
        if (NILP (Voverriding_local_map_menu_flag))
  	{
  	  specbind (Qoverriding_terminal_local_map, Qnil);
--- 1443,1449 ----
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
        if (NILP (Voverriding_local_map_menu_flag))
  	{
  	  specbind (Qoverriding_terminal_local_map, Qnil);
Index: src/xdisp.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xdisp.c,v
retrieving revision 1.1019
diff -c -r1.1019 xdisp.c
*** src/xdisp.c	6 Jun 2005 12:36:29 -0000	1.1019
--- src/xdisp.c	6 Jun 2005 22:19:17 -0000
***************
*** 8458,8464 ****
        Lisp_Object tail, frame;
        int count = SPECPDL_INDEX ();
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
  
        FOR_EACH_FRAME (tail, frame)
  	{
--- 8458,8464 ----
        Lisp_Object tail, frame;
        int count = SPECPDL_INDEX ();
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
  
        FOR_EACH_FRAME (tail, frame)
  	{
***************
*** 8581,8587 ****
  
  	  set_buffer_internal_1 (XBUFFER (w->buffer));
  	  if (save_match_data)
! 	    record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
  	  if (NILP (Voverriding_local_map_menu_flag))
  	    {
  	      specbind (Qoverriding_terminal_local_map, Qnil);
--- 8581,8587 ----
  
  	  set_buffer_internal_1 (XBUFFER (w->buffer));
  	  if (save_match_data)
! 	    record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
  	  if (NILP (Voverriding_local_map_menu_flag))
  	    {
  	      specbind (Qoverriding_terminal_local_map, Qnil);
***************
*** 8772,8778 ****
  
  	  /* Save match data, if we must.  */
  	  if (save_match_data)
! 	    record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
  
  	  /* Make sure that we don't accidentally use bogus keymaps.  */
  	  if (NILP (Voverriding_local_map_menu_flag))
--- 8772,8778 ----
  
  	  /* Save match data, if we must.  */
  	  if (save_match_data)
! 	    record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
  
  	  /* Make sure that we don't accidentally use bogus keymaps.  */
  	  if (NILP (Voverriding_local_map_menu_flag))
Index: src/xmenu.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xmenu.c,v
retrieving revision 1.292
diff -c -r1.292 xmenu.c
*** src/xmenu.c	6 Jun 2005 12:56:53 -0000	1.292
--- src/xmenu.c	6 Jun 2005 22:19:18 -0000
***************
*** 2030,2036 ****
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
        record_unwind_protect (unuse_menu_items, Qnil);
        if (NILP (Voverriding_local_map_menu_flag))
  	{
--- 2030,2036 ----
  	 because it is not reentrant.  */
        specbind (Qdebug_on_next_call, Qnil);
  
!       record_unwind_protect (Fset_match_data, Fmatch_data (Qevaporate, Qnil));
        record_unwind_protect (unuse_menu_items, Qnil);
        if (NILP (Voverriding_local_map_menu_flag))
  	{
Index: lisp/subr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/subr.el,v
retrieving revision 1.459
diff -c -r1.459 subr.el
*** lisp/subr.el	29 May 2005 08:34:46 -0000	1.459
--- lisp/subr.el	6 Jun 2005 22:19:18 -0000
***************
*** 1967,1973 ****
    ;; if you need to recompile all the Lisp files using interpreted code.
    (declare (indent 0) (debug t))
    (list 'let
! 	'((save-match-data-internal (match-data)))
  	(list 'unwind-protect
  	      (cons 'progn body)
  	      '(set-match-data save-match-data-internal))))
--- 1967,1973 ----
    ;; if you need to recompile all the Lisp files using interpreted code.
    (declare (indent 0) (debug t))
    (list 'let
! 	'((save-match-data-internal (match-data 'evaporate)))
  	(list 'unwind-protect
  	      (cons 'progn body)
  	      '(set-match-data save-match-data-internal))))

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk