mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-14 09:39:42 +00:00
318 lines
12 KiB
EmacsLisp
318 lines
12 KiB
EmacsLisp
;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2020-2021 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--symbol-plist)
|
|
(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 (seq-sort (lambda (e1 e2)
|
|
(> (cdr e1) (cdr e2)))
|
|
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--symbol-plist ()
|
|
(let ((counted (make-hash-table :test #'eq))
|
|
(total 0))
|
|
(mapatoms
|
|
(lambda (symbol)
|
|
(cl-incf total (memory-report--object-size
|
|
counted (symbol-plist symbol))))
|
|
obarray)
|
|
(list
|
|
(cons "Memory Used By Symbol Plists" total))))
|
|
|
|
(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
|
|
;; heavy.
|
|
(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))))
|
|
(let ((next (cdr value)))
|
|
(setq value (when next
|
|
(if (consp next)
|
|
(unless (gethash next counted)
|
|
(cdr value))
|
|
(cl-incf total (memory-report--object-size
|
|
counted next))
|
|
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 '("KiB" "MiB" "GiB" "TiB")))
|
|
(while (>= bytes 1024)
|
|
(setq bytes (/ bytes 1024.0))
|
|
(setq units (cdr units)))
|
|
(format "%6.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 (and (consp elem) (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" (if (fboundp 'image-cache-size)
|
|
(image-cache-size)
|
|
0))))
|
|
|
|
(provide 'memory-report)
|
|
|
|
;;; memory-report.el ends here
|