[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 004d7e9 4/4: Add a new command `memory-report'
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 004d7e9 4/4: Add a new command `memory-report' |
|
Date: |
Fri, 11 Dec 2020 08:53:22 -0500 (EST) |
branch: master
commit 004d7e97e2c54c1089a776055ffd173d132fe5ae
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add a new command `memory-report'
* doc/lispref/internals.texi (Garbage Collection): Document it.
* lisp/emacs-lisp/memory-report.el: New package.
---
doc/lispref/internals.texi | 13 ++
etc/NEWS | 5 +
lisp/emacs-lisp/memory-report.el | 299 ++++++++++++++++++++++++++++
test/lisp/emacs-lisp/memory-report-tests.el | 54 +++++
4 files changed, 371 insertions(+)
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index bb25983..fb24544 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -615,6 +615,19 @@ during garbage collection so far in this Emacs session, as
a
floating-point number.
@end defvar
+@defun memory-report
+It can sometimes be useful to see where Emacs is using memory (in
+various variables, buffers, and caches). This command will open a new
+buffer (called @samp{"*Memory Report*"}) that will give an overview,
+in addition to listing the ``largest'' buffers and variables.
+
+All the data here is approximate, because there's really no consistent
+way to compute the size of a variable. For instance, two variables
+may share parts of a data structure, and this will be counted twice,
+but this command may still give a useful high-level overview of which
+parts of Emacs is using memory.
+@end defun
+
@node Stack-allocated Objects
@section Stack-allocated Objects
diff --git a/etc/NEWS b/etc/NEWS
index 1640e27..33cc2c3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -275,6 +275,11 @@ preserving markers, properties and overlays. The new
variable
number of seconds that 'revert-buffer-with-fine-grain' should spend
trying to be non-destructive.
++++
+** New command 'memory-report'.
+This command opens a new buffer called "*Memory Report*" and gives a
+summary of where Emacs is using memory currently.
+
** Outline
+++
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
new file mode 100644
index 0000000..58555fa
--- /dev/null
+++ b/lisp/emacs-lisp/memory-report.el
@@ -0,0 +1,299 @@
+;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Keywords: lisp, help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Todo (possibly): Font cache, regexp cache, bidi cache, various
+;; buffer caches (newline cache, free_region_cache, etc), composition
+;; cache, face cache.
+
+;;; Code:
+
+(require 'seq)
+(require 'subr-x)
+(eval-when-compile (require 'cl-lib))
+
+(defvar memory-report--type-size (make-hash-table))
+
+;;;###autoload
+(defun memory-report ()
+ "Generate a report of how Emacs is using memory.
+
+This report is approximate, and will commonly over-count memory
+usage by variables, because shared data structures will usually
+by counted more than once."
+ (interactive)
+ (pop-to-buffer "*Memory Report*")
+ (special-mode)
+ (button-mode 1)
+ (setq truncate-lines t)
+ (message "Gathering data...")
+ (let ((reports (append (memory-report--garbage-collect)
+ (memory-report--image-cache)
+ (memory-report--buffers)
+ (memory-report--largest-variables)))
+ (inhibit-read-only t)
+ summaries details)
+ (message "Gathering data...done")
+ (erase-buffer)
+ (insert (propertize "Estimated Emacs Memory Usage\n\n" 'face 'bold))
+ (dolist (report reports)
+ (if (listp report)
+ (push report summaries)
+ (push report details)))
+ (dolist (summary (nreverse summaries))
+ (insert (format "%s %s\n"
+ (memory-report--format (cdr summary))
+ (car summary))))
+ (insert "\n")
+ (dolist (detail (nreverse details))
+ (insert detail "\n")))
+ (goto-char (point-min)))
+
+(defun memory-report-object-size (object)
+ "Return the size of OBJECT in bytes."
+ (unless memory-report--type-size
+ (memory-report--garbage-collect))
+ (memory-report--object-size (make-hash-table :test #'eq) object))
+
+(defun memory-report--size (type)
+ (or (gethash type memory-report--type-size)
+ (gethash 'object memory-report--type-size)))
+
+(defun memory-report--set-size (elems)
+ (setf (gethash 'string memory-report--type-size)
+ (cadr (assq 'strings elems)))
+ (setf (gethash 'cons memory-report--type-size)
+ (cadr (assq 'conses elems)))
+ (setf (gethash 'symbol memory-report--type-size)
+ (cadr (assq 'symbols elems)))
+ (setf (gethash 'object memory-report--type-size)
+ (cadr (assq 'vectors elems)))
+ (setf (gethash 'float memory-report--type-size)
+ (cadr (assq 'floats elems)))
+ (setf (gethash 'buffer memory-report--type-size)
+ (cadr (assq 'buffers elems))))
+
+(defun memory-report--garbage-collect ()
+ (let ((elems (garbage-collect)))
+ (memory-report--set-size elems)
+ (let ((data (list
+ (list 'strings
+ (+ (memory-report--gc-elem elems 'strings)
+ (memory-report--gc-elem elems 'string-bytes)))
+ (list 'vectors
+ (+ (memory-report--gc-elem elems 'vectors)
+ (memory-report--gc-elem elems 'vector-slots)))
+ (list 'floats (memory-report--gc-elem elems 'floats))
+ (list 'conses (memory-report--gc-elem elems 'conses))
+ (list 'symbols (memory-report--gc-elem elems 'symbols))
+ (list 'intervals (memory-report--gc-elem elems 'intervals))
+ (list 'buffer-objects
+ (memory-report--gc-elem elems 'buffers)))))
+ (list (cons "Overall Object Memory Usage"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (* (nth 1 elem) (nth 2 elem)))
+ elems)
+ 0))
+ (cons "Reserved (But Unused) Object Memory"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (nth 3 elem)
+ (* (nth 1 elem) (nth 3 elem))
+ 0))
+ elems)
+ 0))
+ (with-temp-buffer
+ (insert (propertize "Object Storage\n\n" 'face 'bold))
+ (dolist (object (seq-sort (lambda (e1 e2)
+ (> (cadr e1) (cadr e2)))
+ data))
+ (insert (format "%s %s\n"
+ (memory-report--format (cadr object))
+ (capitalize (symbol-name (car object))))))
+ (buffer-string))))))
+
+(defun memory-report--largest-variables ()
+ (let ((variables nil))
+ (mapatoms
+ (lambda (symbol)
+ (when (boundp symbol)
+ (let ((size (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (symbol-value symbol))))
+ (when (> size 1000)
+ (push (cons symbol size) variables)))))
+ obarray)
+ (list
+ (cons (propertize "Memory Used By Global Variables"
+ 'help-echo "Upper bound; mutually overlapping data from
different variables are counted several times")
+ (seq-reduce #'+ (mapcar #'cdr variables) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Variables\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (symbol . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ variables)
+ do (insert (memory-report--format size)
+ " "
+ (symbol-name symbol)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--object-size (counted value)
+ (if (gethash value counted)
+ 0
+ (setf (gethash value counted) t)
+ (memory-report--object-size-1 counted value)))
+
+(cl-defgeneric memory-report--object-size-1 (_counted _value)
+ 0)
+
+(cl-defmethod memory-report--object-size-1 (_ (value symbol))
+ ;; Don't count global symbols -- makes sizes of lists of symbols too
+ ;; heavey.
+ (if (intern-soft value obarray)
+ 0
+ (memory-report--size 'symbol)))
+
+(cl-defmethod memory-report--object-size-1 (_ (_value buffer))
+ (memory-report--size 'buffer))
+
+(cl-defmethod memory-report--object-size-1 (counted (value string))
+ (+ (memory-report--size 'string)
+ (string-bytes value)
+ (memory-report--interval-size counted (object-intervals value))))
+
+(defun memory-report--interval-size (counted intervals)
+ ;; We get a list back of intervals, but only count the "inner list"
+ ;; (i.e., the actual text properties), and add the size of the
+ ;; intervals themselves.
+ (+ (* (memory-report--size 'interval) (length intervals))
+ (seq-reduce #'+ (mapcar
+ (lambda (interval)
+ (memory-report--object-size counted (nth 2 interval)))
+ intervals)
+ 0)))
+
+(cl-defmethod memory-report--object-size-1 (counted (value list))
+ (let ((total 0)
+ (size (memory-report--size 'cons)))
+ (while value
+ (cl-incf total size)
+ (setf (gethash value counted) t)
+ (when (car value)
+ (cl-incf total (memory-report--object-size counted (car value))))
+ (if (cdr value)
+ (if (consp (cdr value))
+ (setq value (cdr value))
+ (cl-incf total (memory-report--object-size counted (cdr value)))
+ (setq value nil))
+ (setq value nil)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value vector))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (length value)))))
+ (cl-loop for elem across value
+ do (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted elem)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (hash-table-size value)))))
+ (maphash
+ (lambda (key elem)
+ (setf (gethash key counted) t)
+ (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted key))
+ (cl-incf total (memory-report--object-size counted elem)))
+ value)
+ total))
+
+(defun memory-report--format (bytes)
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '("kB" "MB" "GB" "TB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (format "%5.1f%s" bytes (car units))))
+
+(defun memory-report--gc-elem (elems type)
+ (* (nth 1 (assq type elems))
+ (nth 2 (assq type elems))))
+
+(defun memory-report--buffers ()
+ (let ((buffers (mapcar (lambda (buffer)
+ (cons buffer (memory-report--buffer buffer)))
+ (buffer-list))))
+ (list (cons "Total Buffer Memory Usage"
+ (seq-reduce #'+ (mapcar #'cdr buffers) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Buffers\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (buffer . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ buffers)
+ do (insert (memory-report--format size)
+ " "
+ (button-buttonize
+ (buffer-name buffer)
+ #'memory-report--buffer-details buffer)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--buffer-details (buffer)
+ (with-current-buffer buffer
+ (apply
+ #'message
+ "Buffer text: %s; variables: %s; text properties: %s; overlays: %s"
+ (mapcar #'string-trim (mapcar #'memory-report--format
+ (memory-report--buffer-data buffer))))))
+
+(defun memory-report--buffer (buffer)
+ (seq-reduce #'+ (memory-report--buffer-data buffer) 0))
+
+(defun memory-report--buffer-data (buffer)
+ (with-current-buffer buffer
+ (list (save-restriction
+ (widen)
+ (+ (position-bytes (point-max))
+ (- (position-bytes (point-min)))
+ (gap-size)))
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (cdr elem)
+ (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (cdr elem))
+ 0))
+ (buffer-local-variables buffer))
+ 0)
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (object-intervals buffer))
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (overlay-lists)))))
+
+(defun memory-report--image-cache ()
+ (list (cons "Total Image Cache Size" (image-cache-size))))
+
+(provide 'memory-report)
+
+;;; memory-report.el ends here
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el
b/test/lisp/emacs-lisp/memory-report-tests.el
new file mode 100644
index 0000000..01bcf18
--- /dev/null
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -0,0 +1,54 @@
+;;; memory-report-tests.el --- tests for memory-report.el -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+(require 'memory-report)
+
+(defun setup-memory-report-tests ()
+ (memory-report--set-size
+ '((conses 16 499173 99889)
+ (symbols 48 22244 3)
+ (strings 32 92719 4559)
+ (string-bytes 1 40402011)
+ (vectors 16 31919)
+ (vector-slots 8 385148 149240)
+ (floats 8 434 4519)
+ (intervals 56 24499 997)
+ (buffers 984 33))))
+
+(ert-deftest memory-report-sizes ()
+ (setup-memory-report-tests)
+ (should (equal (memory-report-object-size (cons nil nil)) 16))
+ (should (equal (memory-report-object-size (cons 1 2)) 16))
+
+ (should (equal (memory-report-object-size (list 1 2)) 32))
+ (should (equal (memory-report-object-size (list 1)) 16))
+
+ (should (equal (memory-report-object-size (list 'foo)) 16))
+
+ (should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
+
+ (should (equal (memory-report-object-size "") 32))
+ (should (equal (memory-report-object-size "a") 33))
+ (should (equal (memory-report-object-size (propertize "a" 'face 'foo))
+ 81)))
+
+(provide 'memory-report-tests)
+
+;;; memory-report-tests.el ends here