xemacs-beta: lisp/diagnose.el annotate

annotate lisp/diagnose.el @ 5697:40fbceabaafd

menubar-items.el (default-menubar): Reorganize. Add PROBLEMS to toplevel. New "More about XEmacs" submenu for NEWS, licensing, etc. New "Recent History" menu for messages, lossage, etc. Get rid of ugly and unexpressive ellipses.

author	Stephen J. Turnbull <stephen@xemacs.org>
date	Mon, 24 Dec 2012 03:08:33 +0900
parents	3bc58dc9d688
children

rev	line source
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	1 ;;; diagnose.el --- routines for debugging problems in XEmacs
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	2
5059 c8f90d61dcf3 fix memory usage stats to include pdumped objects Ben Wing <ben@xemacs.org> parents: 4103 diff changeset	3 ;; Copyright (C) 2002, 2010 Ben Wing.
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	4
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	5 ;; Maintainer: XEmacs Development Team
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	6 ;; Keywords: dumped
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	7
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	8 ;; This file is part of XEmacs.
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	9
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	10 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	11 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	12 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	13 ;; option) any later version.
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	14
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	18 ;; for more details.
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	19
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	20 ;; You should have received a copy of the GNU General Public License
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5230 diff changeset	21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	22
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	23 ;;; Synched up with: Not in FSF.
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	24
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	25 ;;; Commentary:
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	26
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	27 ;; This file is dumped with XEmacs.
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	28
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	29 ;;; Code:
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	30
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	31
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	32 (defun show-memory-usage ()
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	33 "Show statistics about memory usage of various sorts in XEmacs."
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	34 (interactive)
242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	35 (garbage-collect)
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	36 (labels ((show-foo-stats (objtypename statname-plist cleanfun objlist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	37 &optional objnamelen)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	38 (let* ((hash (make-hash-table))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	39 (first t)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	40 types origtypes fmt
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	41 (objnamelen (or objnamelen 25))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	42 (linelen objnamelen)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	43 (totaltotal 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	44 (loop for obj in objlist do
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	45 (let ((total 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	46 (stats (object-memory-usage obj)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	47 ;; Pop off the slice describing the object itself's
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	48 ;; memory
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	49 (while (and stats (not (eq t (pop stats)))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	50 ;; Pop off the slice describing the associated
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	51 ;; non-Lisp-Object memory from the allocation
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	52 ;; perspective, so we can get to the slice describing
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	53 ;; the memory grouped by type
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	54 (while (and stats (pop stats)))
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5059 diff changeset	55
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	56 (loop for (type . num) in (remq t stats) while type do
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	57 (if first (push type origtypes))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	58 (setq type (getf statname-plist type type))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	59 (puthash type (+ num (or (gethash type hash) 0)) hash)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	60 (incf total num)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	61 (if first (push type types)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	62 (incf totaltotal total)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	63 (when first
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	64 (setq types (nreverse types))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	65 (setq origtypes (nreverse origtypes))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	66 (setq fmt (concat
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	67 (format "%%-%ds" objnamelen)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	68 (mapconcat
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	69 #'(lambda (type)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	70 (let ((fieldlen
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	71 (max 7 (+ 2 (length
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	72 (symbol-name type))))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	73 (incf linelen fieldlen)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	74 (format "%%%ds" fieldlen)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	75 types "")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	76 (progn (incf linelen 9) "%9s\n")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	77 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	78 (princ (apply 'format fmt objtypename
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	79 (append types (list 'total))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	80 (princ (make-string linelen ?-))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	81 (princ "\n"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	82 (let ((objname (format "%s" (funcall cleanfun obj))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	83 (princ (apply 'format fmt (substring objname 0
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	84 (min (length objname)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	85 (1- objnamelen)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	86 (nconc (mapcar #'(lambda (type)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	87 (cdr (assq type stats)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	88 origtypes)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	89 (list total)))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	90 (setq first nil)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	91 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	92 (princ (apply 'format fmt "total"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	93 (nconc (mapcar #'(lambda (type)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	94 (gethash type hash))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	95 types)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	96 (list totaltotal))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	97 totaltotal)))
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	98 (let ((grandtotal 0)
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	99 (buffer "memory usage")
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	100 begin)
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	101 (with-output-to-temp-buffer buffer
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	102 (save-excursion
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	103 (set-buffer buffer)
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	104 (when-fboundp 'charset-list
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	105 (setq begin (point))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	106 (incf grandtotal
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	107 (show-foo-stats 'charset nil 'charset-name
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5059 diff changeset	108 (mapcar 'get-charset (charset-list))))
3066 a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	109 (when-fboundp 'sort-numeric-fields
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	110 (sort-numeric-fields -1
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	111 (save-excursion
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	112 (goto-char begin)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	113 (forward-line 2)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	114 (point))
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	115 (save-excursion
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	116 (forward-line -2)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	117 (point))))
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	118 (princ "\n"))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	119 (setq begin (point))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	120 (incf grandtotal
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	121 (show-foo-stats 'buffer nil 'buffer-name (buffer-list)))
3066 a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	122 (when-fboundp 'sort-numeric-fields
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	123 (sort-numeric-fields -1
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	124 (save-excursion
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	125 (goto-char begin)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	126 (forward-line 3)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	127 (point))
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	128 (save-excursion
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	129 (forward-line -2)
a88e6130a523 [xemacs-hg @ 2005-11-13 10:56:09 by ben] ben parents: 3041 diff changeset	130 (point))))
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	131 (princ "\n")
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	132 (setq begin (point))
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	133 (incf grandtotal
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	134 (show-foo-stats 'window
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	135 '(line-start-cache line-st.
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	136 face-cache face
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	137 glyph-cache glyph
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	138 redisplay-structs redisplay
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	139 scrollbar-instances scrollbar
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	140 window-mirror mirror)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	141 #'(lambda (x)
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	142 (buffer-name (window-buffer x)))
5157 1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5059 diff changeset	143 (mapcan #'(lambda (fr)
1fae11d56ad2 redo memory-usage mechanism, add way of dynamically initializing Lisp objects Ben Wing <ben@xemacs.org> parents: 5059 diff changeset	144 (window-list fr t))
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	145 (frame-list))
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	146 16))
5368 ed74d2ca7082 Use ', not #', when a given symbol may not have a function binding at read time Aidan Kehoe <kehoea@parhasard.net> parents: 5230 diff changeset	147 (when-fboundp 'sort-numeric-fields
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	148 (sort-numeric-fields -1
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	149 (save-excursion
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	150 (goto-char begin)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	151 (forward-line 3)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	152 (point))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	153 (save-excursion
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	154 (forward-line -2)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	155 (point))))
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	156 (princ "\n")
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	157 (let ((total 0)
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	158 (fmt "%-30s%10s\n"))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	159 (setq begin (point))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	160 (princ (format fmt "object" "storage"))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	161 (princ (make-string 40 ?-))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	162 (princ "\n")
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	163 (map-plist #'(lambda (stat num)
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	164 (when (and
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	165 (not
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	166 (string-match
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	167 "\$.*\$-ancillary-storage$"
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	168 (symbol-name stat)))
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	169 (string-match
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	170 "\$.*\$-storage$"
5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	171 (symbol-name stat)))
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	172 (incf total num)
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	173 (princ (format fmt
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	174 (match-string 1 (symbol-name stat))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	175 num)))
5160 ab9ee10a53e4 fix various problems with allocation statistics, track overhead properly Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	176 )
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	177 (sixth (garbage-collect)))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	178 (princ "\n")
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	179 (princ (format fmt "total" total))
6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	180 (incf grandtotal total))
5368 ed74d2ca7082 Use ', not #', when a given symbol may not have a function binding at read time Aidan Kehoe <kehoea@parhasard.net> parents: 5230 diff changeset	181 (when-fboundp 'sort-numeric-fields
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	182 (sort-numeric-fields -1
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	183 (save-excursion
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	184 (goto-char begin)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	185 (forward-line 2)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	186 (point))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	187 (save-excursion
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	188 (forward-line -2)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	189 (point))))
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	190
2618 6db7dbf7f88b [xemacs-hg @ 2005-02-28 07:43:17 by adrian] adrian parents: 787 diff changeset	191 (princ (format "\n\ngrand total: %s\n" grandtotal)))
787 242b62e9fc59 [xemacs-hg @ 2002-03-20 10:20:48 by ben] ben parents: diff changeset	192 grandtotal))))
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	193
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	194
3041 876730d84b73 [xemacs-hg @ 2005-11-02 03:26:51 by crestani] crestani parents: 2775 diff changeset	195 (defun show-object-memory-usage-stats ()
3888 099851392ea7 [xemacs-hg @ 2007-03-30 14:38:39 by stephent] stephent parents: 3320 diff changeset	196 "Show statistics about object memory usage in XEmacs."
2775 05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	197 (interactive)
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	198 (garbage-collect)
3041 876730d84b73 [xemacs-hg @ 2005-11-02 03:26:51 by crestani] crestani parents: 2775 diff changeset	199 (let ((buffer "object memory usage statistics")
876730d84b73 [xemacs-hg @ 2005-11-02 03:26:51 by crestani] crestani parents: 2775 diff changeset	200 (plist (object-memory-usage-stats))
5170 5ddbab03b0e6 various fixes to memory-usage stats Ben Wing <ben@xemacs.org> parents: 5160 diff changeset	201 (fmt "%-28s%10s%10s%10s%10s%10s\n")
2775 05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	202 (grandtotal 0)
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	203 begin)
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	204 (labels
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	205 ((show-stats (match-string)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	206 (princ (format "%28s%10s%40s\n" "" ""
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	207 "--------------storage---------------"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	208 (princ (format fmt "object" "count" "object" "overhead"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	209 "non-Lisp" "ancillary"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	210 (princ (make-string 78 ?-))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	211 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	212 (let ((total-use 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	213 (total-non-lisp-use 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	214 (total-use-overhead 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	215 (total-use-with-overhead 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	216 (total-count 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	217 (map-plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	218 #'(lambda (stat num)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	219 (let ((symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	220 (and (string-match match-string (symbol-name stat))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	221 (match-string 1 (symbol-name stat)))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	222 (when (and symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	223 (or (< (length symmatch) 9)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	224 (not (equal (substring symmatch -9)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	225 "-non-lisp")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	226 (or (< (length symmatch) 15)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	227 (not (equal (substring symmatch -15)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	228 "-lisp-ancillary"))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	229 (let* ((storage-use num)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	230 (storage-use-overhead
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	231 (or (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	232 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	233 (intern (concat symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	234 "-storage-overhead")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	235 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	236 (storage-use-with-overhead
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	237 (or (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	238 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	239 (intern (concat
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	240 symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	241 "-storage-including-overhead")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	242 (+ storage-use storage-use-overhead)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	243 (storage-use-overhead
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	244 (- storage-use-with-overhead storage-use))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	245 (non-lisp-storage
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	246 (or (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	247 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	248 (intern (concat symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	249 "-non-lisp-storage")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	250 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	251 (lisp-ancillary-storage
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	252 (or (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	253 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	254 (intern (concat symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	255 "-lisp-ancillary-storage")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	256 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	257 (storage-count
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	258 (or (loop for str in '("s-used" "es-used" "-used")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	259 for val = (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	260 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	261 (intern
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	262 (concat symmatch str)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	263 if val
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	264 return val)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	265 (plist-get
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	266 plist
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	267 (intern
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	268 (concat (substring symmatch 0 -1)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	269 "ies-used")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	270 )))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	271 (incf total-use storage-use)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	272 (incf total-use-overhead storage-use-overhead)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	273 (incf total-use-with-overhead storage-use-with-overhead)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	274 (incf total-non-lisp-use non-lisp-storage)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	275 (incf total-count (or storage-count 0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	276 (and (> storage-use-with-overhead 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	277 (princ (format fmt symmatch
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	278 (or storage-count "unknown")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	279 storage-use
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	280 storage-use-overhead
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	281 non-lisp-storage
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	282 lisp-ancillary-storage)))))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	283 plist)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	284 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	285 (princ (format fmt "total"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	286 total-count total-use total-use-overhead
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	287 total-non-lisp-use ""))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	288 (incf grandtotal total-use-with-overhead)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	289 (incf grandtotal total-non-lisp-use)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	290 (when-fboundp 'sort-numeric-fields
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	291 (sort-numeric-fields -4
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	292 (save-excursion
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	293 (goto-char begin)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	294 (forward-line 4)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	295 (point))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	296 (save-excursion
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	297 (forward-line -2)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	298 (point)))))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	299 (with-output-to-temp-buffer buffer
2775 05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	300 (save-excursion
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	301 (set-buffer buffer)
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	302 (setq begin (point))
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5157 diff changeset	303 (princ "Allocated with lisp allocator or related:\n")
2775 05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	304 (show-stats "\$.*\$-storage$")
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	305 (princ (format "\n\ngrand total: %s\n" grandtotal)))
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	306 grandtotal))))
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	307
05d62157e048 [xemacs-hg @ 2005-05-15 16:37:52 by crestani] crestani parents: 2720 diff changeset	308
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	309 (defun show-mc-alloc-memory-usage ()
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	310 "Show statistics about memory usage of the new allocator."
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	311 (interactive)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	312 (garbage-collect)
5368 ed74d2ca7082 Use ', not #', when a given symbol may not have a function binding at read time Aidan Kehoe <kehoea@parhasard.net> parents: 5230 diff changeset	313 (if-fboundp 'mc-alloc-memory-usage
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	314 (let* ((stats (mc-alloc-memory-usage))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	315 (page-size (first stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	316 (heap-sects (second stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	317 (used-plhs (third stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	318 (free-plhs (fourth stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	319 (globals (fifth stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	320 (mc-malloced-bytes (sixth stats)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	321 (with-output-to-temp-buffer "mc-alloc memory usage"
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	322 (labels
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	323 ((print-used-plhs (text plhs)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	324 (let ((sum-n-pages 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	325 (sum-used-n-cells 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	326 (sum-used-space 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	327 (sum-used-total 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	328 (sum-total-n-cells 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	329 (sum-total-space 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	330 (sum-total-total 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	331 (fmt "%7s%7s\|%7s%9s%9s%4s\|%7s%9s%9s%4s\|%4s\n"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	332 (princ (format "%-14s\|%-29s\|%-29s\|\n"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	333 text
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	334 " currently in use"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	335 " total available"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	336 (princ (format fmt "cell-sz" "#pages"
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	337 "#cells" "space" "total" "% "
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	338 "#cells" "space" "total" "% " "% "))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	339 (princ (make-string 79 ?-))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	340 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	341 (while plhs
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	342 (let* ((elem (car plhs))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	343 (cell-size (first elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	344 (n-pages (second elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	345 (used-n-cells (third elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	346 (used-space (fourth elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	347 (used-total (if (zerop cell-size)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	348 (sixth elem)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	349 (* cell-size used-n-cells)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	350 (used-eff (floor (if (not (zerop used-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	351 (* (/ (* used-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	352 (* used-total 1.0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	353 100.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	354 0)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	355 (total-n-cells (fifth elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	356 (total-space (if (zerop cell-size)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	357 used-space
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	358 (* cell-size total-n-cells)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	359 (total-total (sixth elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	360 (total-eff (floor (if (not (zerop total-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	361 (* (/ (* total-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	362 (* total-total 1.0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	363 100.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	364 0)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	365 (eff (floor (if (not (zerop total-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	366 (* (/ (* used-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	367 (* total-total 1.0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	368 100.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	369 0))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	370 (princ (format fmt
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	371 cell-size n-pages used-n-cells used-space
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	372 used-total used-eff total-n-cells
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	373 total-space total-total total-eff eff))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	374 (incf sum-n-pages n-pages)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	375 (incf sum-used-n-cells used-n-cells)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	376 (incf sum-used-space used-space)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	377 (incf sum-used-total used-total)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	378 (incf sum-total-n-cells total-n-cells)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	379 (incf sum-total-space total-space)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	380 (incf sum-total-total total-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	381 (setq plhs (cdr plhs)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	382 (let ((avg-used-eff (floor (if (not (zerop sum-used-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	383 (* (/ (* sum-used-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	384 (* sum-used-total 1.0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	385 100.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	386 0)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	387 (avg-total-eff (floor (if (not (zerop sum-total-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	388 (* (/ (* sum-total-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	389 (* sum-total-total 1.0))
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	390 100.0)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	391 0)))
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	392 (avg-eff (floor (if (not (zerop sum-total-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	393 (* (/ (* sum-used-space 1.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	394 (* sum-total-total 1.0))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	395 100.0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	396 0))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	397 (princ (format fmt "sum " sum-n-pages sum-used-n-cells
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	398 sum-used-space sum-used-total avg-used-eff
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	399 sum-total-n-cells sum-total-space
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	400 sum-total-total avg-total-eff avg-eff))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	401 (princ "\n"))))
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	402
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	403
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	404 (print-free-plhs (text plhs)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	405 (let ((sum-n-pages 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	406 (sum-n-sects 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	407 (sum-space 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	408 (sum-total 0)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	409 (fmt "%6s%10s \|%7s%10s\n"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	410 (princ (format "%s\n" text))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	411 (princ (format fmt "#pages" "space" "#sects" "total"))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	412 (princ (make-string 35 ?-))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	413 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	414 (while plhs
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	415 (let* ((elem (car plhs))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	416 (n-pages (first elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	417 (n-sects (second elem))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	418 (space (* n-pages page-size))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	419 (total (* n-sects space)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	420 (princ (format fmt n-pages space n-sects total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	421 (incf sum-n-pages n-pages)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	422 (incf sum-n-sects n-sects)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	423 (incf sum-space space)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	424 (incf sum-total total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	425 (setq plhs (cdr plhs)))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	426 (princ (make-string 35 ?=))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	427 (princ "\n")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	428 (princ (format fmt sum-n-pages sum-space
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	429 sum-n-sects sum-total))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	430 (princ "\n"))))
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	431
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	432 (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size))
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	433
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	434 (print-used-plhs "USED HEAP" used-plhs)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	435 (princ "\n\n")
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	436
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	437 (print-free-plhs "FREE HEAP" free-plhs)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	438 (princ "\n\n")
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	439
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	440 (let ((fmt "%-30s%10s\n"))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	441 (princ (format fmt "heap sections" ""))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	442 (princ (make-string 40 ?-))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	443 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	444 (princ (format fmt "number of heap sects"
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	445 (first heap-sects)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	446 (princ (format fmt "used size" (second heap-sects)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	447 (princ (make-string 40 ?-))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	448 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	449 (princ (format fmt "real size" (third heap-sects)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	450 (princ (format fmt "global allocator structs" globals))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	451 (princ (make-string 40 ?-))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	452 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	453 (princ (format fmt "real size + structs"
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	454 (+ (third heap-sects) globals)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	455 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	456 (princ (make-string 40 ?=))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	457 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	458 (princ (format fmt "grand total" mc-malloced-bytes)))
2720 6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani] crestani parents: 2618 diff changeset	459
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	460 (+ mc-malloced-bytes))))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	461 (message "mc-alloc not used in this XEmacs.")))
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3066 diff changeset	462
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3066 diff changeset	463
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3066 diff changeset	464 (defun show-gc-stats ()
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3066 diff changeset	465 "Show statistics about garbage collection cycles."
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3066 diff changeset	466 (interactive)
5368 ed74d2ca7082 Use ', not #', when a given symbol may not have a function binding at read time Aidan Kehoe <kehoea@parhasard.net> parents: 5230 diff changeset	467 (if-fboundp 'gc-stats
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	468 (let ((buffer "garbage collection statistics")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	469 (plist (gc-stats))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	470 (fmt "%-9s %16s %12s %12s %12s %12s\n"))
5567 3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	471 (labels
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	472 ((plist-get-stat (category field)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	473 (let ((stat (plist-get plist (intern (concat category field)))))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	474 (if stat
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	475 (format "%.0f" stat)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	476 "-")))
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	477 (show-stats (category)
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	478 (princ (format fmt category
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	479 (plist-get-stat category "-total")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	480 (plist-get-stat category "-in-last-gc")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	481 (plist-get-stat category "-in-this-gc")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	482 (plist-get-stat category "-in-last-cycle")
3bc58dc9d688 Replace #'flet by #'labels where appropriate, core code. Aidan Kehoe <kehoea@parhasard.net> parents: 5473 diff changeset	483 (plist-get-stat category "-in-this-cycle")))))
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	484 (with-output-to-temp-buffer buffer
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	485 (save-excursion
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	486 (set-buffer buffer)
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	487 (princ (format "%s %g\n" "Current phase"
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	488 (plist-get plist 'phase)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	489 (princ (make-string 78 ?-))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	490 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	491 (princ (format fmt "stat" "total" "last-gc" "this-gc"
5230 4c56e7c6a704 Fix a misspelling, diagnose.el. Aidan Kehoe <kehoea@parhasard.net> parents: 5170 diff changeset	492 "last-cycle" "this-cycle"))
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	493 (princ (make-string 78 ?-))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	494 (princ "\n")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	495 (show-stats "n-gc")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	496 (show-stats "n-cycles")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	497 (show-stats "enqueued")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	498 (show-stats "dequeued")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	499 (show-stats "repushed")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	500 (show-stats "enqueued2")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	501 (show-stats "dequeued2")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	502 (show-stats "finalized")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	503 (show-stats "freed")
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	504 (plist-get plist 'n-gc-total)))))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 3888 diff changeset	505 (error 'void-function "gc-stats not available.")))

Mercurial > hg > xemacs-beta

annotate lisp/diagnose.el @ 5697:40fbceabaafd