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 ;;;###autoload
  60 (defun memory-usage ()
  61   "List all buffers and their memory usage."
  62   (interactive)
  63   (pop-to-buffer (get-buffer-create "*Buffer Details*"))
  64   (erase-buffer)
  65   (let* ((bufs (buffer-list))
  66          (num (length bufs))
  67          (gc-stats (garbage-collect))
  68          (conses    (memory-usage-mult-cons 2 (nth 0 gc-stats)))
  69          (symbols   (memory-usage-mult-cons 6 (nth 1 gc-stats)))
  70          (markers   (memory-usage-mult-cons 5 (nth 2 gc-stats)))
  71          (chars     (nth 3 gc-stats))
  72          (vectors   (nth 4 gc-stats))
  73          (floats    (memory-usage-mult-cons 2 (nth 5 gc-stats)))
  74          (intervals (memory-usage-mult-cons 7 (nth 6 gc-stats)))
  75          (strings   (memory-usage-mult-cons 4 (nth 7 gc-stats))))
  76     (insert (format "Garbage collection stats:\n%s\n\n =>" gc-stats))
  77     (insert (format "\t%d+%d bytes in cons cells\n" (car conses) (cdr conses)))
  78     (insert (format "\t%d+%d bytes in symbols\n" (car symbols) (cdr symbols)))
  79     (insert (format "\t%d+%d bytes in markers\n" (car markers) (cdr markers)))
  80     (insert (format "\t%d+%d bytes in floats\n" (car floats) (cdr floats)))
  81     (insert (format "\t%d+%d bytes in intervals\n"
  82                     (car intervals) (cdr intervals)))
  83     (insert (format "\t%d+%d bytes in string headers\n"
  84                     (car strings) (cdr strings)))
  85     (insert (format "\t%d bytes of string chars\n" chars))
  86     (insert (format "\t%d bytes of vector slots\n" vectors))
  87     (let ((live (+ (car conses)
  88                    (car symbols)
  89                    (car markers)
  90                    (car floats)
  91                    (car intervals)
  92                    (car strings)
  93                    chars
  94                    vectors))
  95           (dead (+ (cdr conses)
  96                    (cdr symbols)
  97                    (cdr markers)
  98                    (cdr floats)
  99                    (cdr intervals)
 100                    (cdr strings))))
 101
 102       (insert (format "\nTotal bytes in lisp objects: %d (live %d, dead %d)\n\n"
 103                       (+ dead live) live dead)))
 104
 105     (insert (format "Buffer ralloc memory usage:\n%d buffers\n%d bytes total (%d in gaps)\n"
 106                     num
 107                     (apply #'+ (mapcar #'memory-usage-buffer-total-bytes bufs))
 108                     (apply #'+ (mapcar #'memory-usage-buffer-gap-bytes bufs))))
 109     (insert (format "%10s\t%s\t%s\n\n" "Size" "Gap" "Name"))
 110     (insert (mapconcat
 111              (lambda (b)
 112                (format "%10d\t%s\t%s"
 113                        (memory-usage-buffer-size-bytes b)
 114                        (memory-usage-buffer-gap-bytes b)
 115                        (buffer-name b)))
 116              (sort bufs (lambda (b1 b2)
 117                           (> (memory-usage-buffer-size-bytes b1)
 118                              (memory-usage-buffer-size-bytes b2))))
 119              "\n"))
 120     (insert "\n"))
 121   (goto-char (point-min)))
 122
 123
 124 (provide 'memory-usage)
 125 ;; arch-tag: 04e012f0-3c59-4319-8d1a-e86204671ec5
 126 ;;; memory-usage.el ends here