code.delx.au - gnu-emacs-elpa/blob - packages/memory-usage/memory-usage.el

   1 ;;; memory-usage.el --- Analyze the memory usage of Emacs in various ways
   2
   3 ;; Copyright (C) 2002, 2004, 2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: maint
   7 ;; Version: 0.1
   8
   9 ;; This file is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This package provides the command `memory-usage', which lists all
  27 ;; buffers and how much memory they use.
  28
  29 ;;; Code:
  30
  31 (defvar memory-usage-word-size (ceiling (/ (log most-positive-fixnum 2) 8))
  32   "Size of a Lisp word box in bytes.")
  33
  34 (defun memory-usage-buffer-size-bytes (b)
  35   "Return total number of bytes in the buffer contents."
  36   (with-current-buffer b
  37     (save-restriction
  38       (widen)
  39       (- (position-bytes (point-max)) (position-bytes (point-min))))))
  40
  41 (defun memory-usage-buffer-gap-bytes (b)
  42   "Return total number of bytes in the buffer gap."
  43   (with-current-buffer b
  44     (gap-size)))
  45
  46 (defun memory-usage-buffer-total-bytes (b)
  47   "Return total number of ralloc bytes used by buffer."
  48   (with-current-buffer b
  49     (save-restriction
  50       (widen)
  51       (+ (position-bytes (point-max))
  52          (- (position-bytes (point-min)))
  53          (gap-size)))))
  54
  55 (defun memory-usage-mult-cons (n c)
  56   (setq n (* n memory-usage-word-size))
  57   (cons (* n (car c)) (* n (cdr c))))
  58
  59 (defun memory-usage-format (bytes)
  60   (setq bytes (/ bytes 1024.0))
  61   (let ((units '(;; "B"
  62                  "kB" "MB" "GB" "TB")))
  63     (while (>= bytes 1024)
  64       (setq bytes (/ bytes 1024.0))
  65       (setq units (cdr units)))
  66     (cond
  67      ;; ((integerp bytes) (format "%4d%s" bytes (car units)))
  68      ((>= bytes 100) (format "%4.0f%s" bytes (car units)))
  69      ((>= bytes 10) (format "%4.1f%s" bytes (car units)))
  70      (t (format "%4.2f%s" bytes (car units))))))
  71
  72 ;;;###autoload
  73 (defun memory-usage ()
  74   "List all buffers and their memory usage."
  75   (interactive)
  76   (pop-to-buffer (get-buffer-create "*Buffer Details*"))
  77   (erase-buffer)
  78   (let* ((bufs (buffer-list))
  79          (num (length bufs))
  80          (gc-stats (garbage-collect))
  81          (conses    (memory-usage-mult-cons 2 (nth 0 gc-stats)))
  82          (symbols   (memory-usage-mult-cons 6 (nth 1 gc-stats)))
  83          (markers   (memory-usage-mult-cons 5 (nth 2 gc-stats)))
  84          (chars     (nth 3 gc-stats))
  85          (vectors   (nth 4 gc-stats))
  86          (floats    (memory-usage-mult-cons 2 (nth 5 gc-stats)))
  87          (intervals (memory-usage-mult-cons 7 (nth 6 gc-stats)))
  88          (strings   (memory-usage-mult-cons 4 (nth 7 gc-stats))))
  89     (if (consp vectors) (setq vectors (cdr vectors)))
  90     (insert (format "Garbage collection stats:\n%s\n\n =>" gc-stats))
  91     (dolist (x `(("cons cells" . ,conses)
  92                  ("symbols" . ,symbols)
  93                  ("markers" . ,markers)
  94                  ("floats" . ,floats)
  95                  ("intervals" . ,intervals)
  96                  ("string headers" . ,strings)))
  97       (insert (format "\t%s (+ %s dead) in %s\n"
  98                     (memory-usage-format (cadr x))
  99                     (memory-usage-format (cddr x))
 100                     (car x))))
 101     (insert (format "\t%s of string chars\n" (memory-usage-format chars)))
 102     (insert (format "\t%s of vector slots\n" (memory-usage-format vectors)))
 103     (let ((live (+ (car conses)
 104                    (car symbols)
 105                    (car markers)
 106                    (car floats)
 107                    (car intervals)
 108                    (car strings)
 109                    chars
 110                    vectors))
 111           (dead (+ (cdr conses)
 112                    (cdr symbols)
 113                    (cdr markers)
 114                    (cdr floats)
 115                    (cdr intervals)
 116                    (cdr strings))))
 117
 118       (insert (format "\nTotal in lisp objects: %s (live %s, dead %s)\n\n"
 119                       (memory-usage-format (+ dead live))
 120                       (memory-usage-format live)
 121                       (memory-usage-format dead))))
 122
 123     (insert
 124      (format "Buffer ralloc memory usage:\n%d buffers\n%s total (%s in gaps)\n"
 125              num
 126              (memory-usage-format
 127               (apply #'+ (mapcar #'memory-usage-buffer-total-bytes bufs)))
 128              (memory-usage-format
 129               (apply #'+ (mapcar #'memory-usage-buffer-gap-bytes bufs)))))
 130     (insert (format "%10s\t%s\t%s\n\n" "Size" "Gap" "Name"))
 131     (insert (mapconcat
 132              (lambda (b)
 133                (format "%10d\t%s\t%s"
 134                        (memory-usage-buffer-size-bytes b)
 135                        (memory-usage-buffer-gap-bytes b)
 136                        (buffer-name b)))
 137              (sort bufs (lambda (b1 b2)
 138                           (> (memory-usage-buffer-size-bytes b1)
 139                              (memory-usage-buffer-size-bytes b2))))
 140              "\n"))
 141     (insert "\n"))
 142   (goto-char (point-min)))
 143
 144 (defun memory-usage-find-large-variables ()
 145   "Find variables whose printed representation takes over 100KB."
 146   (interactive)
 147   (let ((min-size (* 100 1024)))
 148     (pop-to-buffer "*Memory Explorer*")
 149     (delete-region (point-min) (point-max))
 150     ;; First find large global variables.
 151     (mapatoms
 152      (lambda (sym)
 153        (let ((size (or (and (boundp sym)
 154                             (length (prin1-to-string (symbol-value sym))))
 155                        0)))
 156          (when (> size min-size)
 157            (insert (format "%d\tGlobal\t%s\n"
 158                            size
 159                            (symbol-name sym)))))))
 160     ;; Second find large buffer-local variables.
 161     (mapc
 162      (lambda (buffer)
 163        (let ((holder ""))
 164          (with-current-buffer buffer
 165            (mapc
 166             (lambda (var-cons)
 167               (let ((size (or (and (consp var-cons)
 168                                    (length (prin1-to-string (cdr var-cons))))
 169                               0)))
 170                 (if (> size min-size)
 171                     (setq holder (format "%d\t%s\t%s\n"
 172                                          size (buffer-name buffer)
 173                                          (symbol-name (car var-cons)))))))
 174             (buffer-local-variables)))
 175          (insert holder)))
 176      (buffer-list))
 177     (sort-numeric-fields 1 (point-min) (point-max))))
 178
 179 (provide 'memory-usage)
 180 ;;; memory-usage.el ends here