GNU bug report logs - #77775
30.1; Proced performance

Previous Next

Full log

View this message in rfc822 format

From: Eli Zaretskii <eliz <at> gnu.org>
To: Rahguzar <rahguzar <at> mailbox.org>, Roland Winkler <winkler <at> gnu.org>, Laurence Warne <laurencewarne <at> gmail.com>
Cc: 77775 <at> debbugs.gnu.org
Subject: bug#77775: 30.1; Proced performance
Date: Sun, 13 Apr 2025 13:44:26 +0300

> Date: Sun, 13 Apr 2025 12:08:04 +0500
> From:  Rahguzar via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs <at> gnu.org>
> 
> 
> Dear Emacs developers,
> 
> I sometimes see pauses when I have a proced buffer with auto update enabled. As a benchmark I tried
> M-: (benchmark-run-compiled 100 (proced-update t t)) RET
> (8.874007655 23 0.4591267360000001)
> 
> >From profiler the what takes most time is:
> 
> 1) Call to `proced-process-attributes' in `proced-update'. This is unavoidable.
> 2) Another call to `proced-process-attributes' in `proced-format'. This call gets attributes for all the process although it only need them for one.
> 
> I tried the diff
> diff --git a/lisp/proced.el b/lisp/proced.el
> index 51e6f3aca4d..c1a27cd0b15 100644
> --- a/lisp/proced.el
> +++ b/lisp/proced.el
> @@ -1748,7 +1748,7 @@ proced-format
>    ;; If none of the alternatives is non-nil, the attribute is ignored
>    ;; in the listing.
>    (let ((standard-attributes
> -         (car (proced-process-attributes (list-system-processes))))
> +         (car (proced-process-attributes (last (list-system-processes)))))
>          new-format fmi)
>      (if (and proced-tree-flag
>               (assq 'ppid standard-attributes))
> 
> (The comment at the start of this diff is outdated)
> 
> After this:
> M-: (benchmark-run-compiled 100 (proced-update t t)) RET
> (5.910094172 18 0.4095661129999999)
> 
> 3) `proced-format-pid' takes a lot of time. The culprit here is a call to `(process-attributes pid)'. To avoid it, I added a new variable `proced-format-current-process` which is let bound to the process being formatted in `proced-format'. This can then be used by format functions to look up other attributes if needed. The diff this time is larger:
> 
> diff --git a/lisp/proced.el b/lisp/proced.el
> index c1a27cd0b15..42782615b33 100644
> --- a/lisp/proced.el
> +++ b/lisp/proced.el
> @@ -428,6 +428,9 @@ proced-sort-internal
>    "Sort scheme for listing (internal format).
>  It is a list of lists (KEY PREDICATE REVERSE).")
>  
> +(defvar proced-format-current-process nil
> +  "Symbol holding the process that is being formatted by function `proced-format'.")
> +
>  (defvar proced-marker-char ?*		; the answer is 42
>    "In Proced, the current mark character.")
>  
> @@ -1682,13 +1685,13 @@ proced-format-state
>  
>  (defun proced-format-pid (pid)
>    "Format PID."
> -  (let ((proc-info (process-attributes pid))
> -        (pid-s (number-to-string pid)))
> +  (let ((pid-s (number-to-string pid)))
>      (cond ((and proced-enable-color-flag
>                  (not (file-remote-p default-directory))
>                  (equal pid (emacs-pid)))
>             (propertize pid-s 'font-lock-face 'proced-emacs-pid))
> -          ((and proced-enable-color-flag (equal pid (alist-get 'sess proc-info)))
> +          ((and proced-enable-color-flag
> +                (equal pid (alist-get 'sess proced-format-current-process)))
>             (propertize pid-s 'font-lock-face 'proced-session-leader-pid))
>            (proced-enable-color-flag
>             (propertize pid-s 'font-lock-face 'proced-pid))
> @@ -1814,7 +1817,8 @@ proced-format
>                   (end-of-line)
>                   (setq value (cdr (assq key (cdr process))))
>                   (insert (if value
> -                             (apply #'propertize (funcall fun value) fprops)
> +                             (let ((proced-format-current-process process))
> +                               (apply #'propertize (funcall fun value) fprops))
>                             (format (concat "%" (number-to-string (nth 3 grammar)) "s")
>                                     unknown))
>                           whitespace)
> @@ -1828,7 +1832,9 @@ proced-format
>                 (dolist (process process-alist)
>                   (end-of-line)
>                   (setq value (cdr (assq key (cdr process))))
> -                 (insert (if value (apply #'propertize (funcall fun value) fprops)
> +                 (insert (if value
> +                             (let ((proced-format-current-process process))
> +                               (apply #'propertize (funcall fun value) fprops))
>                             unknown))
>                   (forward-line))
>                 (push (apply #'propertize (nth 1 grammar) hprops) header-list))
> @@ -1839,7 +1845,8 @@ proced-format
>                   (dolist (process process-alist)
>                     (setq value (cdr (assq key (cdr process))))
>                     (if value
> -                       (setq value (apply #'propertize (funcall fun value) fprops)
> +                       (setq value (let ((proced-format-current-process process))
> +                                     (apply #'propertize (funcall fun value) fprops))
>                               width (max width (length value))
>                               field-list (cons value field-list))
>                       (push unknown field-list)
> 
> but I think straightforward. Now:
> M-: (benchmark-run-compiled 100 (proced-update t t)) RET
> (4.046857128 16 0.441410039)
> 
> Together these two cut down the time `proced-update' by more than a half and the pauses are now much less noticeable.
> 
> Please let me know if these changes are acceptable and I will prepare a patch.

Roland and Laurence, any comments?

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.