From: Alan Mackenzie 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: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5cc691930808ccf7afdbc53ed49ca24badd97013;p=emacs.git 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 6761de11700..764f44a8dd8 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 000995c5b53..3b9f44e55a0 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 69a2a53d5c9..afe87c5ee6a 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