From: Alan Mackenzie <acm@muc.de>
Date: Mon, 14 Mar 2016 21:44:11 +0000 (+0000)
Subject: Fix a cacheing bug, which led to inordinately slow c-beginning-of-defun.
X-Git-Tag: emacs-25.0.93~89^2~69
X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/5cc691930808ccf7afdbc53ed49ca24badd97013

Fix a cacheing bug, which led to inordinately slow c-beginning-of-defun.

* lisp/progmodes/cc-defs.el (c-self-bind-state-cache): New macro.

* lisp/progmodes/cc-engine.el (c-ssb-lit-begin): Always call c-parse-state
rather than just using the cache variable c-state-cache.
(c-syntactic-skip-backward): Invoke c-self-bind-state-cache to isolate calls
to c-parse-state from other uses of the parse state cache.

* lisp/progmodes/cc-cmds.el (c-beginning-of-defun, c-end-of-defun): Invoke
c-self-bind-state-cache around the processing, replacing flawed bindings of
c-state-cache.
---

diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 6761de1170..764f44a8dd 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1594,69 +1594,70 @@ defun."
       (c-region-is-active-p)
       (push-mark))
 
-  (c-save-buffer-state
-      (beginning-of-defun-function end-of-defun-function
-       (start (point))
-       (paren-state (copy-tree (c-parse-state))) ; This must not share list
-					; structure with other users of c-state-cache.
-       (orig-point-min (point-min)) (orig-point-max (point-max))
-       lim			    ; Position of { which has been widened to.
-       where pos case-fold-search)
-
-    (save-restriction
-      (if (eq c-defun-tactic 'go-outward)
-	  (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace.
-		     paren-state orig-point-min orig-point-max)))
-
-      ;; Move back out of any macro/comment/string we happen to be in.
-      (c-beginning-of-macro)
-      (setq pos (c-literal-limits))
-      (if pos (goto-char (car pos)))
-
-      (setq where (c-where-wrt-brace-construct))
-
-      (if (< arg 0)
-	  ;; Move forward to the closing brace of a function.
-	  (progn
-	    (if (memq where '(at-function-end outwith-function))
-		(setq arg (1+ arg)))
-	    (if (< arg 0)
-		(c-while-widening-to-decl-block
-		 (< (setq arg (- (c-forward-to-nth-EOF-} (- arg) where))) 0)))
-	    ;; Move forward to the next opening brace....
-	    (when (and (= arg 0)
-		       (progn
-			 (c-while-widening-to-decl-block
-			  (not (c-syntactic-re-search-forward "{" nil 'eob)))
-			 (eq (char-before) ?{)))
-	      (backward-char)
-	      ;; ... and backward to the function header.
-	      (c-beginning-of-decl-1)
-	      t))
-
-	;; Move backward to the opening brace of a function, making successively
-	;; larger portions of the buffer visible as necessary.
-	(when (> arg 0)
-	  (c-while-widening-to-decl-block
-	   (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0)))
-
-	(when (eq arg 0)
-	  ;; Go backward to this function's header.
-	  (c-beginning-of-decl-1)
-
-	  (setq pos (point))
-	  ;; We're now there, modulo comments and whitespace.
-	  ;; Try to be line oriented; position point at the closest
-	  ;; preceding boi that isn't inside a comment, but if we hit
-	  ;; the previous declaration then we use the current point
-	  ;; instead.
-	  (while (and (/= (point) (c-point 'boi))
-		      (c-backward-single-comment)))
-	  (if (/= (point) (c-point 'boi))
-	      (goto-char pos)))
-
-	(c-keep-region-active)
-	(= arg 0)))))
+  (c-self-bind-state-cache ; We must not share with other users of c-state-cache.
+   (c-save-buffer-state
+       (beginning-of-defun-function
+	end-of-defun-function
+	(start (point))
+	(paren-state (c-parse-state))
+	(orig-point-min (point-min)) (orig-point-max (point-max))
+	lim		    ; Position of { which has been widened to.
+	where pos case-fold-search)
+
+     (save-restriction
+       (if (eq c-defun-tactic 'go-outward)
+	   (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace.
+		      paren-state orig-point-min orig-point-max)))
+
+       ;; Move back out of any macro/comment/string we happen to be in.
+       (c-beginning-of-macro)
+       (setq pos (c-literal-limits))
+       (if pos (goto-char (car pos)))
+
+       (setq where (c-where-wrt-brace-construct))
+
+       (if (< arg 0)
+	   ;; Move forward to the closing brace of a function.
+	   (progn
+	     (if (memq where '(at-function-end outwith-function))
+		 (setq arg (1+ arg)))
+	     (if (< arg 0)
+		 (c-while-widening-to-decl-block
+		  (< (setq arg (- (c-forward-to-nth-EOF-} (- arg) where))) 0)))
+	     ;; Move forward to the next opening brace....
+	     (when (and (= arg 0)
+			(progn
+			  (c-while-widening-to-decl-block
+			   (not (c-syntactic-re-search-forward "{" nil 'eob)))
+			  (eq (char-before) ?{)))
+	       (backward-char)
+	       ;; ... and backward to the function header.
+	       (c-beginning-of-decl-1)
+	       t))
+
+	 ;; Move backward to the opening brace of a function, making successively
+	 ;; larger portions of the buffer visible as necessary.
+	 (when (> arg 0)
+	   (c-while-widening-to-decl-block
+	    (> (setq arg (c-backward-to-nth-BOF-{ arg where)) 0)))
+
+	 (when (eq arg 0)
+	   ;; Go backward to this function's header.
+	   (c-beginning-of-decl-1)
+
+	   (setq pos (point))
+	   ;; We're now there, modulo comments and whitespace.
+	   ;; Try to be line oriented; position point at the closest
+	   ;; preceding boi that isn't inside a comment, but if we hit
+	   ;; the previous declaration then we use the current point
+	   ;; instead.
+	   (while (and (/= (point) (c-point 'boi))
+		       (c-backward-single-comment)))
+	   (if (/= (point) (c-point 'boi))
+	       (goto-char pos)))
+
+	 (c-keep-region-active)
+	 (= arg 0))))))
 
 (defun c-forward-to-nth-EOF-} (n where)
   ;; Skip to the closing brace of the Nth function after point.  If
@@ -1718,66 +1719,68 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
       (c-region-is-active-p)
       (push-mark))
 
-  (c-save-buffer-state
-      (beginning-of-defun-function end-of-defun-function
-       (start (point))
-       (paren-state (copy-tree (c-parse-state))) ; This must not share list
-				  ; structure with other users of c-state-cache.
-       (orig-point-min (point-min)) (orig-point-max (point-max))
-       lim
-       where pos case-fold-search)
-
-    (save-restriction
-      (if (eq c-defun-tactic 'go-outward)
-	  (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace
-		     paren-state orig-point-min orig-point-max)))
-
-      ;; Move back out of any macro/comment/string we happen to be in.
-      (c-beginning-of-macro)
-      (setq pos (c-literal-limits))
-      (if pos (goto-char (car pos)))
-
-      (setq where (c-where-wrt-brace-construct))
+  (c-self-bind-state-cache ; c-state-cache's list structure must not be shared
+			   ; with other users.
+   (c-save-buffer-state
+       (beginning-of-defun-function
+	end-of-defun-function
+	(start (point))
+	(paren-state (c-parse-state))
+	(orig-point-min (point-min)) (orig-point-max (point-max))
+	lim
+	where pos case-fold-search)
+
+     (save-restriction
+       (if (eq c-defun-tactic 'go-outward)
+	   (setq lim (c-widen-to-enclosing-decl-scope ; e.g. class, namespace
+		      paren-state orig-point-min orig-point-max)))
+
+       ;; Move back out of any macro/comment/string we happen to be in.
+       (c-beginning-of-macro)
+       (setq pos (c-literal-limits))
+       (if pos (goto-char (car pos)))
+
+       (setq where (c-where-wrt-brace-construct))
+
+       (if (< arg 0)
+	   ;; Move backwards to the } of a function
+	   (progn
+	     (if (memq where '(at-header outwith-function))
+		 (setq arg (1+ arg)))
+	     (if (< arg 0)
+		 (c-while-widening-to-decl-block
+		  (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0)))
+	     (if (= arg 0)
+		 (c-while-widening-to-decl-block
+		  (progn (c-syntactic-skip-backward "^}")
+			 (not (eq (char-before) ?}))))))
+
+	 ;; Move forward to the } of a function
+	 (if (> arg 0)
+	     (c-while-widening-to-decl-block
+	      (> (setq arg (c-forward-to-nth-EOF-} arg where)) 0))))
+
+       ;; Do we need to move forward from the brace to the semicolon?
+       (when (eq arg 0)
+	 (if (c-in-function-trailer-p)	; after "}" of struct/enum, etc.
+	     (c-syntactic-re-search-forward ";"))
 
-      (if (< arg 0)
-	  ;; Move backwards to the } of a function
-	  (progn
-	    (if (memq where '(at-header outwith-function))
-		(setq arg (1+ arg)))
-	    (if (< arg 0)
-		(c-while-widening-to-decl-block
-		 (< (setq arg (- (c-backward-to-nth-BOF-{ (- arg) where))) 0)))
-	    (if (= arg 0)
-		(c-while-widening-to-decl-block
-		 (progn (c-syntactic-skip-backward "^}")
-			(not (eq (char-before) ?}))))))
-
-	;; Move forward to the } of a function
-	(if (> arg 0)
-	    (c-while-widening-to-decl-block
-	     (> (setq arg (c-forward-to-nth-EOF-} arg where)) 0))))
-
-      ;; Do we need to move forward from the brace to the semicolon?
-      (when (eq arg 0)
-	(if (c-in-function-trailer-p) ; after "}" of struct/enum, etc.
-	    (c-syntactic-re-search-forward ";"))
+	 (setq pos (point))
+	 ;; We're there now, modulo comments and whitespace.
+	 ;; Try to be line oriented; position point after the next
+	 ;; newline that isn't inside a comment, but if we hit the
+	 ;; next declaration then we use the current point instead.
+	 (while (and (not (bolp))
+		     (not (looking-at "\\s *$"))
+		     (c-forward-single-comment)))
+	 (cond ((bolp))
+	       ((looking-at "\\s *$")
+		(forward-line 1))
+	       (t
+		(goto-char pos))))
 
-	(setq pos (point))
-	;; We're there now, modulo comments and whitespace.
-	;; Try to be line oriented; position point after the next
-	;; newline that isn't inside a comment, but if we hit the
-	;; next declaration then we use the current point instead.
-	(while (and (not (bolp))
-		    (not (looking-at "\\s *$"))
-		    (c-forward-single-comment)))
-	(cond ((bolp))
-	      ((looking-at "\\s *$")
-	       (forward-line 1))
-	      (t
-	       (goto-char pos))))
-
-      (c-keep-region-active)
-      (= arg 0))))
+       (c-keep-region-active)
+       (= arg 0)))))
 
 (defun c-defun-name ()
   "Return the name of the current defun, or NIL if there isn't one.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 000995c5b5..3b9f44e55a 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1258,7 +1258,8 @@ been put there by c-put-char-property.  POINT remains unchanged."
 (def-edebug-spec c-clear-char-property t)
 (def-edebug-spec c-clear-char-properties t)
 (def-edebug-spec c-put-overlay t)
-(def-edebug-spec c-delete-overlay t) ;))
+(def-edebug-spec c-delete-overlay t)
+(def-edebug-spec c-self-bind-state-cache t);))
 
 
 ;;; Functions.
@@ -1397,6 +1398,26 @@ been put there by c-put-char-property.  POINT remains unchanged."
        (save-restriction
 	 (widen)
 	 (c-set-cpp-delimiters ,beg ,end)))))
+
+(defmacro c-self-bind-state-cache (&rest forms)
+  ;; Bind the state cache to itself and execute the FORMS.  It is assumed that no
+  ;; buffer changes will happen in FORMS, and no hidden buffer changes which could
+  ;; affect the parsing will be made by FORMS.
+  `(let ((c-state-cache (copy-tree c-state-cache))
+	 (c-state-cache-good-pos c-state-cache-good-pos)
+	 ;(c-state-nonlit-pos-cache (copy-tree c-state-nonlit-pos-cache))
+	 ;(c-state-nonlit-pos-cache-limit c-state-nonlit-pos-cache-limit)
+	 ;(c-state-semi-nonlit-pos-cache (copy-treec c-state-semi-nonlit-pos-cache))
+	 ;(c-state-semi-nonlit-pos-cache-limit c-state-semi-nonlit-pos-cache)
+	 (c-state-brace-pair-desert (copy-tree c-state-brace-pair-desert))
+	 (c-state-point-min c-state-point-min)
+	 (c-state-point-min-lit-type c-state-point-min-lit-type)
+	 (c-state-point-min-lit-start c-state-point-min-lit-start)
+	 (c-state-min-scan-pos c-state-min-scan-pos)
+	 (c-state-old-cpp-beg c-state-old-cpp-beg)
+	 (c-state-old-cpp-end c-state-old-cpp-end))
+     ,@forms))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; The following macros are to be used only in `c-parse-state' and its
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 69a2a53d5c..afe87c5ee6 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -4259,8 +4259,7 @@ comment at the start of cc-engine.el for more info."
 	(setq safe-pos-list (cdr safe-pos-list)))
       (unless (setq safe-pos (car-safe safe-pos-list))
 	(setq safe-pos (max (or (c-safe-position
-				 (point) (or c-state-cache
-					     (c-parse-state)))
+				 (point) (c-parse-state))
 				0)
 			    (point-min))
 	      safe-pos-list (list safe-pos)))
@@ -4308,107 +4307,108 @@ Non-nil is returned if the point moved, nil otherwise.
 Note that this function might do hidden buffer changes.  See the
 comment at the start of cc-engine.el for more info."
 
-  (let ((start (point))
-	state-2
-	;; A list of syntactically relevant positions in descending
-	;; order.  It's used to avoid scanning repeatedly over
-	;; potentially large regions with `parse-partial-sexp' to verify
-	;; each position.  Used in `c-ssb-lit-begin'
-	safe-pos-list
-	;; The result from `c-beginning-of-macro' at the start position or the
-	;; start position itself if it isn't within a macro.  Evaluated on
-	;; demand.
-	start-macro-beg
-	;; The earliest position after the current one with the same paren
-	;; level.  Used only when `paren-level' is set.
-	lit-beg
-	(paren-level-pos (point)))
-
-    (while
-	(progn
-	  ;; The next loop "tries" to find the end point each time round,
-	  ;; loops when it hasn't succeeded.
-	  (while
-	      (and
-	       (let ((pos (point)))
-		 (while (and
-			 (< (skip-chars-backward skip-chars limit) 0)
-			 ;; Don't stop inside a literal.
-			 (when (setq lit-beg (c-ssb-lit-begin))
-			   (goto-char lit-beg)
-			   t)))
-		 (< (point) pos))
+  (c-self-bind-state-cache
+   (let ((start (point))
+	 state-2
+	 ;; A list of syntactically relevant positions in descending
+	 ;; order.  It's used to avoid scanning repeatedly over
+	 ;; potentially large regions with `parse-partial-sexp' to verify
+	 ;; each position.  Used in `c-ssb-lit-begin'
+	 safe-pos-list
+	 ;; The result from `c-beginning-of-macro' at the start position or the
+	 ;; start position itself if it isn't within a macro.  Evaluated on
+	 ;; demand.
+	 start-macro-beg
+	 ;; The earliest position after the current one with the same paren
+	 ;; level.  Used only when `paren-level' is set.
+	 lit-beg
+	 (paren-level-pos (point)))
+
+     (while
+	 (progn
+	   ;; The next loop "tries" to find the end point each time round,
+	   ;; loops when it hasn't succeeded.
+	   (while
+	       (and
+		(let ((pos (point)))
+		  (while (and
+			  (< (skip-chars-backward skip-chars limit) 0)
+			  ;; Don't stop inside a literal.
+			  (when (setq lit-beg (c-ssb-lit-begin))
+			    (goto-char lit-beg)
+			    t)))
+		  (< (point) pos))
+
+		(let ((pos (point)) state-2 pps-end-pos)
 
-	       (let ((pos (point)) state-2 pps-end-pos)
+		  (cond
+		   ((and paren-level
+			 (save-excursion
+			   (setq state-2 (parse-partial-sexp
+					  pos paren-level-pos -1)
+				 pps-end-pos (point))
+			   (/= (car state-2) 0)))
+		    ;; Not at the right level.
+
+		    (if (and (< (car state-2) 0)
+			     ;; We stop above if we go out of a paren.
+			     ;; Now check whether it precedes or is
+			     ;; nested in the starting sexp.
+			     (save-excursion
+			       (setq state-2
+				     (parse-partial-sexp
+				      pps-end-pos paren-level-pos
+				      nil nil state-2))
+			       (< (car state-2) 0)))
+
+			;; We've stopped short of the starting position
+			;; so the hit was inside a nested list.  Go up
+			;; until we are at the right level.
+			(condition-case nil
+			    (progn
+			      (goto-char (scan-lists pos -1
+						     (- (car state-2))))
+			      (setq paren-level-pos (point))
+			      (if (and limit (>= limit paren-level-pos))
+				  (progn
+				    (goto-char limit)
+				    nil)
+				t))
+			  (error
+			   (goto-char (or limit (point-min)))
+			   nil))
+
+		      ;; The hit was outside the list at the start
+		      ;; position.  Go to the start of the list and exit.
+		      (goto-char (1+ (elt state-2 1)))
+		      nil))
+
+		   ((c-beginning-of-macro limit)
+		    ;; Inside a macro.
+		    (if (< (point)
+			   (or start-macro-beg
+			       (setq start-macro-beg
+				     (save-excursion
+				       (goto-char start)
+				       (c-beginning-of-macro limit)
+				       (point)))))
+			t
+
+		      ;; It's inside the same macro we started in so it's
+		      ;; a relevant match.
+		      (goto-char pos)
+		      nil))))))
 
-		 (cond
-		  ((and paren-level
-			(save-excursion
-			  (setq state-2 (parse-partial-sexp
-					 pos paren-level-pos -1)
-				pps-end-pos (point))
-			  (/= (car state-2) 0)))
-		   ;; Not at the right level.
-
-		   (if (and (< (car state-2) 0)
-			    ;; We stop above if we go out of a paren.
-			    ;; Now check whether it precedes or is
-			    ;; nested in the starting sexp.
-			    (save-excursion
-			      (setq state-2
-				    (parse-partial-sexp
-				     pps-end-pos paren-level-pos
-				     nil nil state-2))
-			      (< (car state-2) 0)))
-
-		       ;; We've stopped short of the starting position
-		       ;; so the hit was inside a nested list.  Go up
-		       ;; until we are at the right level.
-		       (condition-case nil
-			   (progn
-			     (goto-char (scan-lists pos -1
-						    (- (car state-2))))
-			     (setq paren-level-pos (point))
-			     (if (and limit (>= limit paren-level-pos))
-				 (progn
-				   (goto-char limit)
-				   nil)
-			       t))
-			 (error
-			  (goto-char (or limit (point-min)))
-			  nil))
-
-		     ;; The hit was outside the list at the start
-		     ;; position.  Go to the start of the list and exit.
-		     (goto-char (1+ (elt state-2 1)))
-		     nil))
-
-		  ((c-beginning-of-macro limit)
-		   ;; Inside a macro.
-		   (if (< (point)
-			  (or start-macro-beg
-			      (setq start-macro-beg
-				    (save-excursion
-				      (goto-char start)
-				      (c-beginning-of-macro limit)
-				      (point)))))
-		       t
-
-		     ;; It's inside the same macro we started in so it's
-		     ;; a relevant match.
-		     (goto-char pos)
-		     nil))))))
-
-	  (> (point)
-	     (progn
-	       ;; Skip syntactic ws afterwards so that we don't stop at the
-	       ;; end of a comment if `skip-chars' is something like "^/".
-	       (c-backward-syntactic-ws)
-	       (point)))))
+	   (> (point)
+	      (progn
+		;; Skip syntactic ws afterwards so that we don't stop at the
+		;; end of a comment if `skip-chars' is something like "^/".
+		(c-backward-syntactic-ws)
+		(point)))))
 
-    ;; We might want to extend this with more useful return values in
-    ;; the future.
-    (/= (point) start)))
+     ;; We might want to extend this with more useful return values in
+     ;; the future.
+     (/= (point) start))))
 
 ;; The following is an alternative implementation of
 ;; `c-syntactic-skip-backward' that uses backward movement to keep