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.2
   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          (gc-stats (if (numberp (caar gc-stats))
  82                        (mapcar (lambda (x)
  83                                  `(,(car x)
  84                                    ,(max (* memory-usage-word-size (cadr x))
  85                                          1)
  86                                    ,@(let ((stat (nth (cddr x) gc-stats)))
  87                                        (if (consp stat)
  88                                            (list (car stat) (cdr stat))
  89                                          (list stat)))))
  90                                '((cons 2 . 0)
  91                                  (symbol 6 . 1)
  92                                  (marker 5 . 2)
  93                                  (string 4 . 7)
  94                                  (string-byte 0 . 3)
  95                                  (vector-slot 1 . 4)
  96                                  (float 2 . 5)
  97                                  (interval 7 . 6)))
  98                      gc-stats)))
  99     (insert (format "Garbage collection stats:\n%s\n\n =>" gc-stats))
 100     (let ((live 0)
 101           (dead 0))
 102       (dolist (x gc-stats)
 103         (let* ((size (nth 1 x))
 104                (xlive (* size (nth 2 x)))
 105                (xdead (if (nth 3 x) (* size (nth 3 x)))))
 106           (insert (if xdead
 107                       (format "\t%s (+ %s dead) in %s\n"
 108                               (memory-usage-format xlive)
 109                               (memory-usage-format xdead)
 110                               (car x))
 111                     (format "\t%s in %s\n"
 112                             (memory-usage-format xlive)
 113                             (car x))))
 114           (setq live (+ live xlive))
 115           (if xdead (setq dead (+ dead xdead)))))
 116
 117       (insert (format "\nTotal in lisp objects: %s (live %s, dead %s)\n\n"
 118                       (memory-usage-format (+ dead live))
 119                       (memory-usage-format live)
 120                       (memory-usage-format dead))))
 121
 122     (insert
 123      (format "Buffer ralloc memory usage:\n%d buffers\n%s total (%s in gaps)\n"
 124              num
 125              (memory-usage-format
 126               (apply #'+ (mapcar #'memory-usage-buffer-total-bytes bufs)))
 127              (memory-usage-format
 128               (apply #'+ (mapcar #'memory-usage-buffer-gap-bytes bufs)))))
 129     (insert (format "%10s\t%s\t%s\n\n" "Size" "Gap" "Name"))
 130     (insert (mapconcat
 131              (lambda (b)
 132                (format "%10d\t%s\t%s"
 133                        (memory-usage-buffer-size-bytes b)
 134                        (memory-usage-buffer-gap-bytes b)
 135                        (buffer-name b)))
 136              (sort bufs (lambda (b1 b2)
 137                           (> (memory-usage-buffer-size-bytes b1)
 138                              (memory-usage-buffer-size-bytes b2))))
 139              "\n"))
 140     (insert "\n"))
 141   (goto-char (point-min)))
 142
 143 (defun memory-usage-find-large-variables ()
 144   "Find variables whose printed representation takes over 100KB."
 145   (interactive)
 146   (let ((min-size (* 100 1024)))
 147     (pop-to-buffer "*Memory Explorer*")
 148     (delete-region (point-min) (point-max))
 149     ;; First find large global variables.
 150     (mapatoms
 151      (lambda (sym)
 152        (let ((size (or (and (boundp sym)
 153                             (length (prin1-to-string (symbol-value sym))))
 154                        0)))
 155          (when (> size min-size)
 156            (insert (format "%d\tGlobal\t%s\n"
 157                            size
 158                            (symbol-name sym)))))))
 159     ;; Second find large buffer-local variables.
 160     (mapc
 161      (lambda (buffer)
 162        (let ((holder ""))
 163          (with-current-buffer buffer
 164            (mapc
 165             (lambda (var-cons)
 166               (let ((size (or (and (consp var-cons)
 167                                    (length (prin1-to-string (cdr var-cons))))
 168                               0)))
 169                 (if (> size min-size)
 170                     (setq holder (format "%d\t%s\t%s\n"
 171                                          size (buffer-name buffer)
 172                                          (symbol-name (car var-cons)))))))
 173             (buffer-local-variables)))
 174          (insert holder)))
 175      (buffer-list))
 176     (sort-numeric-fields 1 (point-min) (point-max))))
 177
 178 (provide 'memory-usage)
 179 ;;; memory-usage.el ends here