comparison lisp/diagnose.el @ 5059:c8f90d61dcf3

fix memory usage stats to include pdumped objects -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-21 Ben Wing <ben@xemacs.org> * diagnose.el: * diagnose.el (show-object-memory-usage-stats): Fix errors preventing this from working properly, account for words like "entry" pluralized to "entries". src/ChangeLog addition: 2010-02-21 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): * alloc.c (struct): * alloc.c (tick_lrecord_stats): * alloc.c (tick_lcrecord_stats): * alloc.c (sweep_lcrecords_1): * alloc.c (COUNT_FROB_BLOCK_USAGE): * alloc.c (SWEEP_FIXED_TYPE_BLOCK_1): * alloc.c (free_cons): * alloc.c (free_key_data): * alloc.c (free_button_data): * alloc.c (free_motion_data): * alloc.c (free_process_data): * alloc.c (free_timeout_data): * alloc.c (free_magic_data): * alloc.c (free_magic_eval_data): * alloc.c (free_eval_data): * alloc.c (free_misc_user_data): * alloc.c (free_marker): * alloc.c (gc_sweep_1): * alloc.c (HACK_O_MATIC): * alloc.c (FROB): * alloc.c (object_memory_usage_stats): * alloc.c (Fgarbage_collect): * dumper.c: * dumper.c (pdump_objects_unmark): * lrecord.h: * lrecord.h (enum lrecord_alloc_status): Fixes to memory-usage-tracking code, etc. (1) Incorporate NEW_GC stuff into FREE_FIXED_TYPE_WHEN_NOT_IN_GC to avoid duplication. (2) Rewrite tick_lcrecord_stats() to include separate tick_lrecord_stats(); use in dumper.c to note pdumped objects. (3) Instead of handling frob-block objects specially in object_memory_usage_stats(), have SWEEP_FIXED_TYPE_BLOCK_1 increment the stats in lrecord_stats[] so that they get handled like other objects. (4) Pluralize entry as entries, etc.
author Ben Wing <ben@xemacs.org>
date Sun, 21 Feb 2010 15:29:12 -0600
parents b4f4e0cc90f1
children 1fae11d56ad2
comparison
equal deleted inserted replaced
5058:eb17f0c176ac 5059:c8f90d61dcf3
1 ;;; diagnose.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, 2010 Ben Wing.
4 4
5 ;; Maintainer: XEmacs Development Team 5 ;; Maintainer: XEmacs Development Team
6 ;; Keywords: dumped 6 ;; Keywords: dumped
7 7
8 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
195 (plist-get 195 (plist-get
196 plist 196 plist
197 (intern (concat (match-string 1 (symbol-name stat)) 197 (intern (concat (match-string 1 (symbol-name stat))
198 "-storage-including-overhead")))) 198 "-storage-including-overhead"))))
199 (storage-count 199 (storage-count
200 (or (plist-get 200 (or (loop for str in '("s-used" "es-used" "-used")
201 plist 201 for val = (plist-get
202 (intern 202 plist
203 (concat (match-string 1 (symbol-name stat)) 203 (intern
204 "s-used"))) 204 (concat (match-string
205 1 (symbol-name stat))
206 str)))
207 if val
208 return val)
205 (plist-get 209 (plist-get
206 plist 210 plist
207 (intern 211 (intern
208 (concat (match-string 1 (symbol-name stat)) 212 (concat (substring
209 "es-used"))) 213 (match-string 1 (symbol-name stat))
210 (plist-get 214 0 -1)
211 plist 215 "ies-used")))
212 (intern 216 )))
213 (concat (match-string 1 (symbol-name stat))
214 "-used"))))))
215 (incf total-use storage-use) 217 (incf total-use storage-use)
216 (incf total-use-overhead (if storage-use-overhead 218 (incf total-use-overhead (if storage-use-overhead
217 storage-use-overhead 219 storage-use-overhead
218 storage-use)) 220 storage-use))
219 (incf total-count storage-count) 221 (incf total-count (or storage-count 0))
220 (princ (format fmt 222 (and (> storage-use 0)
221 (match-string 1 (symbol-name stat)) 223 (princ (format fmt
222 storage-count storage-use))))) 224 (match-string 1 (symbol-name stat))
225 (or storage-count "unknown")
226 storage-use))))))
223 plist) 227 plist)
224 (princ "\n") 228 (princ "\n")
225 (princ (format fmt "total" 229 (princ (format fmt "total"
226 total-count total-use-overhead)) 230 total-count total-use-overhead))
227 (incf grandtotal total-use-overhead) 231 (incf grandtotal total-use-overhead)
228 (when-fboundp #'sort-numeric-fields 232 (when-fboundp #'sort-numeric-fields
229 (sort-numeric-fields -1 233 (sort-numeric-fields -1
230 (save-excursion 234 (save-excursion
231 (goto-char begin) 235 (goto-char begin)
232 (forward-line 2) 236 (forward-line 3)
233 (point)) 237 (point))
234 (save-excursion 238 (save-excursion
235 (forward-line -2) 239 (forward-line -2)
236 (point))))))) 240 (point)))))))
237 (with-output-to-temp-buffer buffer 241 (with-output-to-temp-buffer buffer