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