Mercurial > hg > xemacs-beta

comparison lisp/diagnose.el @ 2618:6db7dbf7f88b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-02-28 07:43:17 by adrian] [PATCH] xemacs-21.5-clean: show-memory-usage to sort sections by <fyzlbidk.fsf@smtprelay.t-online.de>
author adrian
date Mon, 28 Feb 2005 07:43:18 +0000
parents 242b62e9fc59
children 6fa9919a9a0b
comparison
equal deleted inserted replaced
2617:dfc913af3408 2618:6db7dbf7f88b
1 ;;; debug.el --- routines for debugging problems in XEmacs 1 ;;; diagnose.el --- routines for debugging problems in XEmacs
2 2
3 ;; Copyright (C) 2002 Ben Wing. 3 ;; Copyright (C) 2002 Ben Wing.
4 4
5 ;; Maintainer: XEmacs Development Team 5 ;; Maintainer: XEmacs Development Team
6 ;; Keywords: dumped 6 ;; Keywords: dumped
60 (max 8 (+ 2 (length 60 (max 8 (+ 2 (length
61 (symbol-name type)))))) 61 (symbol-name type))))))
62 (incf linelen fieldlen) 62 (incf linelen fieldlen)
63 (format "%%%ds" fieldlen))) 63 (format "%%%ds" fieldlen)))
64 types "") 64 types "")
65 (progn (incf linelen 8) "%8s\n"))) 65 (progn (incf linelen 9) "%9s\n")))
66 (princ "\n") 66 (princ "\n")
67 (princ (apply 'format fmt objtypename 67 (princ (apply 'format fmt objtypename
68 (append types (list 'total)))) 68 (append types (list 'total))))
69 (princ (make-string linelen ?-)) 69 (princ (make-string linelen ?-))
70 (princ "\n")) 70 (princ "\n"))
83 (gethash type hash)) 83 (gethash type hash))
84 types) 84 types)
85 (list totaltotal)))) 85 (list totaltotal))))
86 totaltotal))) 86 totaltotal)))
87 87
88 (let ((grandtotal 0)) 88 (let ((grandtotal 0)
89 (with-output-to-temp-buffer "*memory usage*" 89 (buffer "*memory usage*")
90 (when-fboundp 'charset-list 90 begin)
91 (with-output-to-temp-buffer buffer
92 (save-excursion
93 (set-buffer buffer)
94 (when-fboundp 'charset-list
95 (setq begin (point))
96 (incf grandtotal
97 (show-foo-stats 'charset (charset-list)
98 #'charset-memory-usage))
99 (sort-numeric-fields -1
100 (save-excursion
101 (goto-char begin)
102 (forward-line 2)
103 (point))
104 (save-excursion
105 (forward-line -2)
106 (point)))
107 (princ "\n"))
108 (setq begin (point))
91 (incf grandtotal 109 (incf grandtotal
92 (show-foo-stats 'charset (charset-list) 110 (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage))
93 #'charset-memory-usage)) 111 (sort-numeric-fields -1
94 (princ "\n")) 112 (save-excursion
95 (incf grandtotal 113 (goto-char begin)
96 (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage)) 114 (forward-line 3)
97 (princ "\n") 115 (point))
98 (incf grandtotal 116 (save-excursion
99 (show-foo-stats 'window (mapcan #'(lambda (fr) 117 (forward-line -2)
100 (window-list fr t)) 118 (point)))
101 (frame-list))
102 #'window-memory-usage))
103 (princ "\n")
104 (let ((total 0)
105 (fmt "%-30s%10s\n"))
106 (princ (format fmt "object" "storage"))
107 (princ (make-string 40 ?-))
108 (princ "\n") 119 (princ "\n")
109 (map-plist #'(lambda (stat num) 120 (setq begin (point))
110 (when (string-match "\\(.*\\)-storage$" 121 (incf grandtotal
111 (symbol-name stat)) 122 (show-foo-stats 'window (mapcan #'(lambda (fr)
112 (incf total num) 123 (window-list fr t))
113 (princ (format fmt 124 (frame-list))
114 (match-string 1 (symbol-name stat)) 125 #'window-memory-usage))
115 num))) 126 (sort-numeric-fields -1
116 (when (eq stat 'long-strings-total-length) 127 (save-excursion
117 (incf total num) 128 (goto-char begin)
118 (princ (format fmt stat num)))) 129 (forward-line 3)
119 (sixth (garbage-collect))) 130 (point))
131 (save-excursion
132 (forward-line -2)
133 (point)))
120 (princ "\n") 134 (princ "\n")
121 (princ (format fmt "total" total)) 135 (let ((total 0)
122 (incf grandtotal total)) 136 (fmt "%-30s%10s\n"))
137 (setq begin (point))
138 (princ (format fmt "object" "storage"))
139 (princ (make-string 40 ?-))
140 (princ "\n")
141 (map-plist #'(lambda (stat num)
142 (when (string-match "\\(.*\\)-storage$"
143 (symbol-name stat))
144 (incf total num)
145 (princ (format fmt
146 (match-string 1 (symbol-name stat))
147 num)))
148 (when (eq stat 'long-strings-total-length)
149 (incf total num)
150 (princ (format fmt stat num))))
151 (sixth (garbage-collect)))
152 (princ "\n")
153 (princ (format fmt "total" total))
154 (incf grandtotal total))
155 (sort-numeric-fields -1
156 (save-excursion
157 (goto-char begin)
158 (forward-line 2)
159 (point))
160 (save-excursion
161 (forward-line -2)
162 (point)))
123 163
124 (princ (format "\n\ngrand total: %s\n" grandtotal)) 164 (princ (format "\n\ngrand total: %s\n" grandtotal)))
125 grandtotal)))) 165 grandtotal))))