Mercurial > hg > xemacs-beta

comparison lisp/diagnose.el @ 3092:141c2920ea48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-11-25 01:41:31 by crestani] Incremental Garbage Collector
author crestani
date Fri, 25 Nov 2005 01:42:08 +0000
parents a88e6130a523
children aa0d3b22be72
comparison
equal deleted inserted replaced
3091:c22d8984148c 3092:141c2920ea48
140 (princ (format fmt "object" "storage")) 140 (princ (format fmt "object" "storage"))
141 (princ (make-string 40 ?-)) 141 (princ (make-string 40 ?-))
142 (princ "\n") 142 (princ "\n")
143 (map-plist #'(lambda (stat num) 143 (map-plist #'(lambda (stat num)
144 (when (string-match 144 (when (string-match
145 "\\(.*\\)-storage\\(-additional\\)?$" 145 "\\(.*\\)-storage\\$"
146 (symbol-name stat)) 146 (symbol-name stat))
147 (incf total num) 147 (incf total num)
148 (princ (format fmt 148 (princ (format fmt
149 (match-string 1 (symbol-name stat)) 149 (match-string 1 (symbol-name stat))
150 num))) 150 num)))
235 (save-excursion 235 (save-excursion
236 (set-buffer buffer) 236 (set-buffer buffer)
237 (setq begin (point)) 237 (setq begin (point))
238 (princ "Allocated with lisp allocator:\n") 238 (princ "Allocated with lisp allocator:\n")
239 (show-stats "\\(.*\\)-storage$") 239 (show-stats "\\(.*\\)-storage$")
240 (princ "\n\n")
241 (setq begin (point))
242 (princ "Allocated additionally:\n")
243 (show-stats "\\(.*\\)-storage-additional$")
244 (princ (format "\n\ngrand total: %s\n" grandtotal))) 240 (princ (format "\n\ngrand total: %s\n" grandtotal)))
245 grandtotal)))) 241 grandtotal))))
246 242
247 243
248 (defun show-mc-alloc-memory-usage () 244 (defun show-mc-alloc-memory-usage ()
251 (garbage-collect) 247 (garbage-collect)
252 (let* ((stats (mc-alloc-memory-usage)) 248 (let* ((stats (mc-alloc-memory-usage))
253 (page-size (first stats)) 249 (page-size (first stats))
254 (heap-sects (second stats)) 250 (heap-sects (second stats))
255 (used-plhs (third stats)) 251 (used-plhs (third stats))
256 (unmanaged-plhs (fourth stats)) 252 (free-plhs (fourth stats))
257 (free-plhs (fifth stats)) 253 (globals (fifth stats))
258 (globals (sixth stats)) 254 (mc-malloced-bytes (sixth stats)))
259 (mc-malloced-bytes (seventh stats)))
260 (with-output-to-temp-buffer "*memory usage*" 255 (with-output-to-temp-buffer "*memory usage*"
261 (flet ((print-used-plhs (text plhs) 256 (flet ((print-used-plhs (text plhs)
262 (let ((sum-n-pages 0) 257 (let ((sum-n-pages 0)
263 (sum-used-n-cells 0) 258 (sum-used-n-cells 0)
264 (sum-used-space 0) 259 (sum-used-space 0)
370 (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) 365 (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size))
371 366
372 (print-used-plhs "USED HEAP" used-plhs) 367 (print-used-plhs "USED HEAP" used-plhs)
373 (princ "\n\n") 368 (princ "\n\n")
374 369
375 (print-used-plhs "UNMANAGED HEAP" unmanaged-plhs)
376 (princ "\n\n")
377
378 (print-free-plhs "FREE HEAP" free-plhs) 370 (print-free-plhs "FREE HEAP" free-plhs)
379 (princ "\n\n") 371 (princ "\n\n")
380 372
381 (let ((fmt "%-30s%10s\n")) 373 (let ((fmt "%-30s%10s\n"))
382 (princ (format fmt "heap sections" "")) 374 (princ (format fmt "heap sections" ""))
397 (princ (make-string 40 ?=)) 389 (princ (make-string 40 ?=))
398 (princ "\n") 390 (princ "\n")
399 (princ (format fmt "grand total" mc-malloced-bytes))) 391 (princ (format fmt "grand total" mc-malloced-bytes)))
400 392
401 (+ mc-malloced-bytes))))) 393 (+ mc-malloced-bytes)))))
394
395
396 (defun show-gc-stats ()
397 "Show statistics about garbage collection cycles."
398 (interactive)
399 (let ((buffer "*garbage collection statistics*")
400 (plist (gc-stats))
401 (fmt "%-9s %10s %10s %10s %10s %10s\n"))
402 (flet ((plist-get-stat (category field)
403 (or (plist-get plist (intern (concat category field)))
404 "-"))
405 (show-stats (category)
406 (princ (format fmt category
407 (plist-get-stat category "-total")
408 (plist-get-stat category "-in-last-gc")
409 (plist-get-stat category "-in-this-gc")
410 (plist-get-stat category "-in-last-cycle")
411 (plist-get-stat category "-in-this-cycle")))))
412 (with-output-to-temp-buffer buffer
413 (save-excursion
414 (set-buffer buffer)
415 (princ (format "%s %s\n" "Current phase" (plist-get plist 'phase)))
416 (princ (make-string 64 ?-))
417 (princ "\n")
418 (princ (format fmt "stat" "total" "last-gc" "this-gc"
419 "last-cycle" "this-cylce"))
420 (princ (make-string 64 ?-))
421 (princ "\n")
422 (show-stats "n-gc")
423 (show-stats "n-cycles")
424 (show-stats "enqueued")
425 (show-stats "dequeued")
426 (show-stats "repushed")
427 (show-stats "enqueued2")
428 (show-stats "dequeued2")
429 (show-stats "finalized")
430 (show-stats "freed")
431 (princ (make-string 64 ?-))
432 (princ "\n")
433 (princ (format fmt "explicitly"
434 "freed:"
435 (plist-get-stat "explicitly" "-freed")
436 "tried:"
437 (plist-get-stat "explicitly" "-tried-freed")
438 "")))
439
440 (plist-get plist 'n-gc-total)))))