Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
5159:cb303ff63e76 | 5160:ab9ee10a53e4 |
---|---|
157 (symbol-name stat)) | 157 (symbol-name stat)) |
158 (incf total num) | 158 (incf total num) |
159 (princ (format fmt | 159 (princ (format fmt |
160 (match-string 1 (symbol-name stat)) | 160 (match-string 1 (symbol-name stat)) |
161 num))) | 161 num))) |
162 (when (eq stat 'long-strings-total-length) | 162 ) |
163 (incf total num) | |
164 (princ (format fmt stat num)))) | |
165 (sixth (garbage-collect))) | 163 (sixth (garbage-collect))) |
166 (princ "\n") | 164 (princ "\n") |
167 (princ (format fmt "total" total)) | 165 (princ (format fmt "total" total)) |
168 (incf grandtotal total)) | 166 (incf grandtotal total)) |
169 (when-fboundp #'sort-numeric-fields | 167 (when-fboundp #'sort-numeric-fields |
184 "Show statistics about object memory usage in XEmacs." | 182 "Show statistics about object memory usage in XEmacs." |
185 (interactive) | 183 (interactive) |
186 (garbage-collect) | 184 (garbage-collect) |
187 (let ((buffer "*object memory usage statistics*") | 185 (let ((buffer "*object memory usage statistics*") |
188 (plist (object-memory-usage-stats)) | 186 (plist (object-memory-usage-stats)) |
189 (fmt "%-30s%10s%10s%18s\n") | 187 (fmt "%-30s%10s%10s%10s%18s\n") |
190 (grandtotal 0) | 188 (grandtotal 0) |
191 begin) | 189 begin) |
192 (flet ((show-stats (match-string) | 190 (flet ((show-stats (match-string) |
193 (princ (format fmt "object" "count" "storage" "non-Lisp storage")) | 191 (princ (format fmt "object" "count" "storage" "overhead" |
194 (princ (make-string 68 ?-)) | 192 "non-Lisp storage")) |
193 (princ (make-string 78 ?-)) | |
195 (princ "\n") | 194 (princ "\n") |
196 (let ((total-use 0) | 195 (let ((total-use 0) |
197 (total-non-lisp-use 0) | 196 (total-non-lisp-use 0) |
198 (total-use-overhead 0) | 197 (total-use-overhead 0) |
198 (total-use-with-overhead 0) | |
199 (total-count 0)) | 199 (total-count 0)) |
200 (map-plist | 200 (map-plist |
201 #'(lambda (stat num) | 201 #'(lambda (stat num) |
202 (when (and (string-match match-string | 202 (let ((symmatch |
203 (symbol-name stat)) | 203 (and (string-match match-string (symbol-name stat)) |
204 (let ((match (match-string | 204 (match-string 1 (symbol-name stat))))) |
205 1 (symbol-name stat)))) | 205 (when (and symmatch (or (< (length symmatch) 9) |
206 (or (< (length match) 9) | 206 (not (equal (substring symmatch -9) |
207 (not (equal (substring match -9) | 207 "-non-lisp")))) |
208 "-non-lisp"))))) | 208 (let* ((storage-use num) |
209 (let ((storage-use num) | 209 (storage-use-overhead |
210 (storage-use-overhead | 210 (or (plist-get |
211 (plist-get | 211 plist |
212 plist | 212 (intern (concat symmatch |
213 (intern (concat (match-string 1 (symbol-name stat)) | 213 "-storage-overhead"))) |
214 "-storage-including-overhead")))) | 214 0)) |
215 (non-lisp-storage | 215 (storage-use-with-overhead |
216 (or (plist-get | 216 (or (plist-get |
217 plist | 217 plist |
218 (intern (concat (match-string 1 | 218 (intern (concat |
219 (symbol-name stat)) | 219 symmatch |
220 "-non-lisp-storage"))) | 220 "-storage-including-overhead"))) |
221 0)) | 221 (+ storage-use storage-use-overhead))) |
222 | 222 (storage-use-overhead |
223 (storage-count | 223 (- storage-use-with-overhead storage-use)) |
224 (or (loop for str in '("s-used" "es-used" "-used") | 224 (non-lisp-storage |
225 for val = (plist-get | 225 (or (plist-get |
226 plist | 226 plist |
227 (intern | 227 (intern (concat symmatch |
228 (concat (match-string | 228 "-non-lisp-storage"))) |
229 1 (symbol-name stat)) | 229 0)) |
230 str))) | 230 (storage-count |
231 if val | 231 (or (loop for str in '("s-used" "es-used" "-used") |
232 return val) | 232 for val = (plist-get |
233 (plist-get | 233 plist |
234 plist | 234 (intern |
235 (intern | 235 (concat symmatch str))) |
236 (concat (substring | 236 if val |
237 (match-string 1 (symbol-name stat)) | 237 return val) |
238 0 -1) | 238 (plist-get |
239 "ies-used"))) | 239 plist |
240 ))) | 240 (intern |
241 (incf total-use storage-use) | 241 (concat (substring symmatch 0 -1) |
242 (incf total-use-overhead (if storage-use-overhead | 242 "ies-used"))) |
243 storage-use-overhead | 243 ))) |
244 storage-use)) | 244 (incf total-use storage-use) |
245 (incf total-non-lisp-use non-lisp-storage) | 245 (incf total-use-overhead storage-use-overhead) |
246 (incf total-count (or storage-count 0)) | 246 (incf total-use-with-overhead storage-use-with-overhead) |
247 (and (> storage-use 0) | 247 (incf total-non-lisp-use non-lisp-storage) |
248 (princ (format fmt | 248 (incf total-count (or storage-count 0)) |
249 (match-string 1 (symbol-name stat)) | 249 (and (> storage-use-with-overhead 0) |
250 (or storage-count "unknown") | 250 (princ (format fmt symmatch |
251 storage-use | 251 (or storage-count "unknown") |
252 non-lisp-storage)))))) | 252 storage-use |
253 storage-use-overhead | |
254 non-lisp-storage))))))) | |
253 plist) | 255 plist) |
254 (princ "\n") | 256 (princ "\n") |
255 (princ (format fmt "total" | 257 (princ (format fmt "total" |
256 total-count total-use-overhead total-non-lisp-use)) | 258 total-count total-use total-use-overhead |
257 (incf grandtotal total-use-overhead) | 259 total-non-lisp-use)) |
260 (incf grandtotal total-use-with-overhead) | |
261 (incf grandtotal total-non-lisp-use) | |
258 (when-fboundp #'sort-numeric-fields | 262 (when-fboundp #'sort-numeric-fields |
259 (sort-numeric-fields -2 | 263 (sort-numeric-fields -3 |
260 (save-excursion | 264 (save-excursion |
261 (goto-char begin) | 265 (goto-char begin) |
262 (forward-line 3) | 266 (forward-line 3) |
263 (point)) | 267 (point)) |
264 (save-excursion | 268 (save-excursion |