Mercurial > hg > xemacs-beta
annotate lisp/diagnose.el @ 5160:ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-20 Ben Wing <ben@xemacs.org>
* diagnose.el (show-memory-usage):
* diagnose.el (show-object-memory-usage-stats):
Further changes to correspond with changes in the C code;
add an additional column showing the overhead used with each type,
and add it into the grand total memory usage.
src/ChangeLog addition:
2010-03-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (init_lrecord_stats):
* alloc.c (free_normal_lisp_object):
* alloc.c (struct):
* alloc.c (clear_lrecord_stats):
* alloc.c (tick_lrecord_stats):
* alloc.c (COUNT_FROB_BLOCK_USAGE):
* alloc.c (COPY_INTO_LRECORD_STATS):
* alloc.c (sweep_strings):
* alloc.c (UNMARK_string):
* alloc.c (gc_sweep_1):
* alloc.c (finish_object_memory_usage_stats):
* alloc.c (object_memory_usage_stats):
* alloc.c (object_dead_p):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* emacs.c (main_1):
* lisp.h:
* lrecord.h:
Export lisp_object_storage_size() and malloced_storage_size() even
when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS
build to compile.
Don't export fixed_type_block_overhead() any more.
Some code cleanup, rearrangement, add some section headers.
Clean up various bugs especially involving computation of overhead
and double-counting certain usage in total_gc_usage. Add
statistics computing the overhead used by all types. Don't add a
special entry for string headers in the object-memory-usage-stats
because it's already present as just "string". But do count the
overhead used by long strings. Don't try to call the
memory_usage() methods when NEW_GC because there's nowhere obvious
in the sweep stage to make the calls.
* marker.c (compute_buffer_marker_usage):
Just use lisp_object_storage_size() rather than trying to
reimplement it.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 20 Mar 2010 20:20:30 -0500 |
parents | 9e0b43d3095c |
children | 5ddbab03b0e6 |
rev | line source |
---|---|
2618 | 1 ;;; diagnose.el --- routines for debugging problems in XEmacs |
787 | 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 | 4 |
5 ;; Maintainer: XEmacs Development Team | |
6 ;; Keywords: dumped | |
7 | |
8 ;; This file is part of XEmacs. | |
9 | |
10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
11 ;; under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; XEmacs is distributed in the hope that it will be useful, but | |
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
18 ;; General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
23 ;; 02111-1307, USA. | |
24 | |
25 ;;; Synched up with: Not in FSF. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; This file is dumped with XEmacs. | |
30 | |
31 ;;; Code: | |
32 | |
33 | |
34 (defun show-memory-usage () | |
35 "Show statistics about memory usage of various sorts in XEmacs." | |
36 (interactive) | |
37 (garbage-collect) | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
38 (flet ((show-foo-stats (objtypename cleanfun objlist) |
787 | 39 (let* ((hash (make-hash-table)) |
40 (first t) | |
41 types fmt | |
42 (objnamelen 25) | |
43 (linelen objnamelen) | |
44 (totaltotal 0)) | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
45 (loop for obj in objlist do |
787 | 46 (let ((total 0) |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
47 (stats (object-memory-usage obj))) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
48 ;; Pop off the slice describing the object itself's |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
49 ;; memory |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
50 (while (and stats (not (eq t (pop stats))))) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
51 ;; Pop off the slice describing the associated |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
52 ;; non-Lisp-Object memory from the allocation |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
53 ;; perspective, so we can get to the slice describing |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
54 ;; the memory grouped by type |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
55 (while (and stats (pop stats))) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
56 |
787 | 57 (loop for (type . num) in stats while type do |
58 (puthash type (+ num (or (gethash type hash) 0)) hash) | |
59 (incf total num) | |
60 (if first (push type types))) | |
61 (incf totaltotal total) | |
62 (when first | |
63 (setq types (nreverse types)) | |
64 (setq fmt (concat | |
65 (format "%%-%ds" objnamelen) | |
66 (mapconcat | |
67 #'(lambda (type) | |
68 (let ((fieldlen | |
69 (max 8 (+ 2 (length | |
70 (symbol-name type)))))) | |
71 (incf linelen fieldlen) | |
72 (format "%%%ds" fieldlen))) | |
73 types "") | |
2618 | 74 (progn (incf linelen 9) "%9s\n"))) |
787 | 75 (princ "\n") |
76 (princ (apply 'format fmt objtypename | |
77 (append types (list 'total)))) | |
78 (princ (make-string linelen ?-)) | |
79 (princ "\n")) | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
80 (let ((objname (format "%s" (funcall cleanfun obj)))) |
787 | 81 (princ (apply 'format fmt (substring objname 0 |
82 (min (length objname) | |
83 (1- objnamelen))) | |
84 (nconc (mapcar #'(lambda (type) | |
85 (cdr (assq type stats))) | |
86 types) | |
87 (list total))))) | |
88 (setq first nil))) | |
89 (princ "\n") | |
90 (princ (apply 'format fmt "total" | |
91 (nconc (mapcar #'(lambda (type) | |
92 (gethash type hash)) | |
93 types) | |
94 (list totaltotal)))) | |
95 totaltotal))) | |
96 | |
2618 | 97 (let ((grandtotal 0) |
98 (buffer "*memory usage*") | |
99 begin) | |
100 (with-output-to-temp-buffer buffer | |
101 (save-excursion | |
102 (set-buffer buffer) | |
103 (when-fboundp 'charset-list | |
104 (setq begin (point)) | |
105 (incf grandtotal | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
106 (show-foo-stats 'charset 'charset-name |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
107 (mapcar 'get-charset (charset-list)))) |
3066 | 108 (when-fboundp 'sort-numeric-fields |
109 (sort-numeric-fields -1 | |
110 (save-excursion | |
111 (goto-char begin) | |
112 (forward-line 2) | |
113 (point)) | |
114 (save-excursion | |
115 (forward-line -2) | |
116 (point)))) | |
2618 | 117 (princ "\n")) |
118 (setq begin (point)) | |
119 (incf grandtotal | |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
120 (show-foo-stats 'buffer 'buffer-name (buffer-list))) |
3066 | 121 (when-fboundp 'sort-numeric-fields |
122 (sort-numeric-fields -1 | |
123 (save-excursion | |
124 (goto-char begin) | |
125 (forward-line 3) | |
126 (point)) | |
127 (save-excursion | |
128 (forward-line -2) | |
129 (point)))) | |
2618 | 130 (princ "\n") |
131 (setq begin (point)) | |
787 | 132 (incf grandtotal |
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
133 (show-foo-stats 'window #'(lambda (x) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
134 (buffer-name (window-buffer x))) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
135 (mapcan #'(lambda (fr) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
136 (window-list fr t)) |
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
137 (frame-list)))) |
4103 | 138 (when-fboundp #'sort-numeric-fields |
139 (sort-numeric-fields -1 | |
140 (save-excursion | |
141 (goto-char begin) | |
142 (forward-line 3) | |
143 (point)) | |
144 (save-excursion | |
145 (forward-line -2) | |
146 (point)))) | |
787 | 147 (princ "\n") |
2618 | 148 (let ((total 0) |
149 (fmt "%-30s%10s\n")) | |
150 (setq begin (point)) | |
151 (princ (format fmt "object" "storage")) | |
152 (princ (make-string 40 ?-)) | |
153 (princ "\n") | |
154 (map-plist #'(lambda (stat num) | |
2775 | 155 (when (string-match |
3278 | 156 "\\(.*\\)-storage$" |
2775 | 157 (symbol-name stat)) |
2618 | 158 (incf total num) |
159 (princ (format fmt | |
160 (match-string 1 (symbol-name stat)) | |
161 num))) | |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
162 ) |
2618 | 163 (sixth (garbage-collect))) |
164 (princ "\n") | |
165 (princ (format fmt "total" total)) | |
166 (incf grandtotal total)) | |
4103 | 167 (when-fboundp #'sort-numeric-fields |
168 (sort-numeric-fields -1 | |
169 (save-excursion | |
170 (goto-char begin) | |
171 (forward-line 2) | |
172 (point)) | |
173 (save-excursion | |
174 (forward-line -2) | |
175 (point)))) | |
787 | 176 |
2618 | 177 (princ (format "\n\ngrand total: %s\n" grandtotal))) |
787 | 178 grandtotal)))) |
2720 | 179 |
180 | |
3041 | 181 (defun show-object-memory-usage-stats () |
3888 | 182 "Show statistics about object memory usage in XEmacs." |
2775 | 183 (interactive) |
184 (garbage-collect) | |
3041 | 185 (let ((buffer "*object memory usage statistics*") |
186 (plist (object-memory-usage-stats)) | |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
187 (fmt "%-30s%10s%10s%10s%18s\n") |
2775 | 188 (grandtotal 0) |
189 begin) | |
190 (flet ((show-stats (match-string) | |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
191 (princ (format fmt "object" "count" "storage" "overhead" |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
192 "non-Lisp storage")) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
193 (princ (make-string 78 ?-)) |
2775 | 194 (princ "\n") |
195 (let ((total-use 0) | |
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
196 (total-non-lisp-use 0) |
2775 | 197 (total-use-overhead 0) |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
198 (total-use-with-overhead 0) |
2775 | 199 (total-count 0)) |
200 (map-plist | |
201 #'(lambda (stat num) | |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
202 (let ((symmatch |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
203 (and (string-match match-string (symbol-name stat)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
204 (match-string 1 (symbol-name stat))))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
205 (when (and symmatch (or (< (length symmatch) 9) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
206 (not (equal (substring symmatch -9) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
207 "-non-lisp")))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
208 (let* ((storage-use num) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
209 (storage-use-overhead |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
210 (or (plist-get |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
211 plist |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
212 (intern (concat symmatch |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
213 "-storage-overhead"))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
214 0)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
215 (storage-use-with-overhead |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
216 (or (plist-get |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
217 plist |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
218 (intern (concat |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
219 symmatch |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
220 "-storage-including-overhead"))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
221 (+ storage-use storage-use-overhead))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
222 (storage-use-overhead |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
223 (- storage-use-with-overhead storage-use)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
224 (non-lisp-storage |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
225 (or (plist-get |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
226 plist |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
227 (intern (concat symmatch |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
228 "-non-lisp-storage"))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
229 0)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
230 (storage-count |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
231 (or (loop for str in '("s-used" "es-used" "-used") |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
232 for val = (plist-get |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
233 plist |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
234 (intern |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
235 (concat symmatch str))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
236 if val |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
237 return val) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
238 (plist-get |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
239 plist |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
240 (intern |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
241 (concat (substring symmatch 0 -1) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
242 "ies-used"))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
243 ))) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
244 (incf total-use storage-use) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
245 (incf total-use-overhead storage-use-overhead) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
246 (incf total-use-with-overhead storage-use-with-overhead) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
247 (incf total-non-lisp-use non-lisp-storage) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
248 (incf total-count (or storage-count 0)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
249 (and (> storage-use-with-overhead 0) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
250 (princ (format fmt symmatch |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
251 (or storage-count "unknown") |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
252 storage-use |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
253 storage-use-overhead |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
254 non-lisp-storage))))))) |
2775 | 255 plist) |
256 (princ "\n") | |
257 (princ (format fmt "total" | |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
258 total-count total-use total-use-overhead |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
259 total-non-lisp-use)) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
260 (incf grandtotal total-use-with-overhead) |
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
261 (incf grandtotal total-non-lisp-use) |
4103 | 262 (when-fboundp #'sort-numeric-fields |
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
263 (sort-numeric-fields -3 |
4103 | 264 (save-excursion |
265 (goto-char begin) | |
5059
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4103
diff
changeset
|
266 (forward-line 3) |
4103 | 267 (point)) |
268 (save-excursion | |
269 (forward-line -2) | |
270 (point))))))) | |
2775 | 271 (with-output-to-temp-buffer buffer |
272 (save-excursion | |
273 (set-buffer buffer) | |
274 (setq begin (point)) | |
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
275 (princ "Allocated with lisp allocator or related:\n") |
2775 | 276 (show-stats "\\(.*\\)-storage$") |
277 (princ (format "\n\ngrand total: %s\n" grandtotal))) | |
278 grandtotal)))) | |
279 | |
280 | |
2720 | 281 (defun show-mc-alloc-memory-usage () |
282 "Show statistics about memory usage of the new allocator." | |
283 (interactive) | |
284 (garbage-collect) | |
4103 | 285 (if-fboundp #'mc-alloc-memory-usage |
286 (let* ((stats (mc-alloc-memory-usage)) | |
287 (page-size (first stats)) | |
288 (heap-sects (second stats)) | |
289 (used-plhs (third stats)) | |
290 (free-plhs (fourth stats)) | |
291 (globals (fifth stats)) | |
292 (mc-malloced-bytes (sixth stats))) | |
293 (with-output-to-temp-buffer "*mc-alloc memory usage*" | |
294 (flet ((print-used-plhs (text plhs) | |
295 (let ((sum-n-pages 0) | |
296 (sum-used-n-cells 0) | |
297 (sum-used-space 0) | |
298 (sum-used-total 0) | |
299 (sum-total-n-cells 0) | |
300 (sum-total-space 0) | |
301 (sum-total-total 0) | |
302 (fmt "%7s%7s|%7s%9s%9s%4s|%7s%9s%9s%4s|%4s\n")) | |
303 (princ (format "%-14s|%-29s|%-29s|\n" | |
304 text | |
305 " currently in use" | |
306 " total available")) | |
307 (princ (format fmt "cell-sz" "#pages" | |
308 "#cells" "space" "total" "% " | |
309 "#cells" "space" "total" "% " "% ")) | |
310 (princ (make-string 79 ?-)) | |
311 (princ "\n") | |
312 (while plhs | |
313 (let* ((elem (car plhs)) | |
314 (cell-size (first elem)) | |
315 (n-pages (second elem)) | |
316 (used-n-cells (third elem)) | |
317 (used-space (fourth elem)) | |
318 (used-total (if (zerop cell-size) | |
319 (sixth elem) | |
320 (* cell-size used-n-cells))) | |
321 (used-eff (floor (if (not (zerop used-total)) | |
322 (* (/ (* used-space 1.0) | |
323 (* used-total 1.0)) | |
324 100.0) | |
325 0))) | |
326 (total-n-cells (fifth elem)) | |
327 (total-space (if (zerop cell-size) | |
328 used-space | |
329 (* cell-size total-n-cells))) | |
330 (total-total (sixth elem)) | |
331 (total-eff (floor (if (not (zerop total-total)) | |
332 (* (/ (* total-space 1.0) | |
333 (* total-total 1.0)) | |
334 100.0) | |
335 0))) | |
336 (eff (floor (if (not (zerop total-total)) | |
337 (* (/ (* used-space 1.0) | |
338 (* total-total 1.0)) | |
339 100.0) | |
340 0)))) | |
341 (princ (format fmt | |
342 cell-size n-pages used-n-cells used-space | |
343 used-total used-eff total-n-cells | |
344 total-space total-total total-eff eff)) | |
345 (incf sum-n-pages n-pages) | |
346 (incf sum-used-n-cells used-n-cells) | |
347 (incf sum-used-space used-space) | |
348 (incf sum-used-total used-total) | |
349 (incf sum-total-n-cells total-n-cells) | |
350 (incf sum-total-space total-space) | |
351 (incf sum-total-total total-total)) | |
352 (setq plhs (cdr plhs))) | |
353 (let ((avg-used-eff (floor (if (not (zerop sum-used-total)) | |
354 (* (/ (* sum-used-space 1.0) | |
355 (* sum-used-total 1.0)) | |
356 100.0) | |
357 0))) | |
358 (avg-total-eff (floor (if (not (zerop sum-total-total)) | |
359 (* (/ (* sum-total-space 1.0) | |
360 (* sum-total-total 1.0)) | |
361 100.0) | |
362 0))) | |
363 (avg-eff (floor (if (not (zerop sum-total-total)) | |
364 (* (/ (* sum-used-space 1.0) | |
365 (* sum-total-total 1.0)) | |
366 100.0) | |
367 0)))) | |
368 (princ (format fmt "sum " sum-n-pages sum-used-n-cells | |
369 sum-used-space sum-used-total avg-used-eff | |
370 sum-total-n-cells sum-total-space | |
371 sum-total-total avg-total-eff avg-eff)) | |
372 (princ "\n")))) | |
2720 | 373 |
374 | |
4103 | 375 (print-free-plhs (text plhs) |
376 (let ((sum-n-pages 0) | |
377 (sum-n-sects 0) | |
378 (sum-space 0) | |
379 (sum-total 0) | |
380 (fmt "%6s%10s |%7s%10s\n")) | |
381 (princ (format "%s\n" text)) | |
382 (princ (format fmt "#pages" "space" "#sects" "total")) | |
383 (princ (make-string 35 ?-)) | |
384 (princ "\n") | |
385 (while plhs | |
386 (let* ((elem (car plhs)) | |
387 (n-pages (first elem)) | |
388 (n-sects (second elem)) | |
389 (space (* n-pages page-size)) | |
390 (total (* n-sects space))) | |
391 (princ (format fmt n-pages space n-sects total)) | |
392 (incf sum-n-pages n-pages) | |
393 (incf sum-n-sects n-sects) | |
394 (incf sum-space space) | |
395 (incf sum-total total)) | |
396 (setq plhs (cdr plhs))) | |
397 (princ (make-string 35 ?=)) | |
398 (princ "\n") | |
399 (princ (format fmt sum-n-pages sum-space | |
400 sum-n-sects sum-total)) | |
401 (princ "\n")))) | |
2720 | 402 |
4103 | 403 (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) |
2720 | 404 |
4103 | 405 (print-used-plhs "USED HEAP" used-plhs) |
406 (princ "\n\n") | |
2720 | 407 |
4103 | 408 (print-free-plhs "FREE HEAP" free-plhs) |
409 (princ "\n\n") | |
2720 | 410 |
4103 | 411 (let ((fmt "%-30s%10s\n")) |
412 (princ (format fmt "heap sections" "")) | |
413 (princ (make-string 40 ?-)) | |
414 (princ "\n") | |
415 (princ (format fmt "number of heap sects" | |
416 (first heap-sects))) | |
417 (princ (format fmt "used size" (second heap-sects))) | |
418 (princ (make-string 40 ?-)) | |
419 (princ "\n") | |
420 (princ (format fmt "real size" (third heap-sects))) | |
421 (princ (format fmt "global allocator structs" globals)) | |
422 (princ (make-string 40 ?-)) | |
423 (princ "\n") | |
424 (princ (format fmt "real size + structs" | |
425 (+ (third heap-sects) globals))) | |
426 (princ "\n") | |
427 (princ (make-string 40 ?=)) | |
428 (princ "\n") | |
429 (princ (format fmt "grand total" mc-malloced-bytes))) | |
2720 | 430 |
4103 | 431 (+ mc-malloced-bytes)))) |
432 (message "mc-alloc not used in this XEmacs."))) | |
3092 | 433 |
434 | |
435 (defun show-gc-stats () | |
436 "Show statistics about garbage collection cycles." | |
437 (interactive) | |
4103 | 438 (if-fboundp #'gc-stats |
439 (let ((buffer "*garbage collection statistics*") | |
440 (plist (gc-stats)) | |
441 (fmt "%-9s %16s %12s %12s %12s %12s\n")) | |
442 (flet ((plist-get-stat (category field) | |
443 (let ((stat (plist-get plist | |
444 (intern (concat category field))))) | |
445 (if stat | |
446 (format "%.0f" stat) | |
447 "-"))) | |
448 (show-stats (category) | |
449 (princ (format fmt category | |
450 (plist-get-stat category "-total") | |
451 (plist-get-stat category "-in-last-gc") | |
452 (plist-get-stat category "-in-this-gc") | |
453 (plist-get-stat category "-in-last-cycle") | |
454 (plist-get-stat category "-in-this-cycle"))))) | |
455 (with-output-to-temp-buffer buffer | |
456 (save-excursion | |
457 (set-buffer buffer) | |
458 (princ (format "%s %g\n" "Current phase" | |
459 (plist-get plist 'phase))) | |
460 (princ (make-string 78 ?-)) | |
461 (princ "\n") | |
462 (princ (format fmt "stat" "total" "last-gc" "this-gc" | |
463 "last-cycle" "this-cylce")) | |
464 (princ (make-string 78 ?-)) | |
465 (princ "\n") | |
466 (show-stats "n-gc") | |
467 (show-stats "n-cycles") | |
468 (show-stats "enqueued") | |
469 (show-stats "dequeued") | |
470 (show-stats "repushed") | |
471 (show-stats "enqueued2") | |
472 (show-stats "dequeued2") | |
473 (show-stats "finalized") | |
474 (show-stats "freed") | |
475 (plist-get plist 'n-gc-total))))) | |
476 (error 'void-function "gc-stats not available."))) |