Mercurial > hg > xemacs-beta

comparison lisp/diagnose.el @ 3313:509d2981ffea

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-03-28 17:43:43 by crestani] EMACS_INT -> double for gc_state, gc_state related clean up
author crestani
date Tue, 28 Mar 2006 17:43:54 +0000
parents aa0d3b22be72
children a921f5f2aa11
comparison
equal deleted inserted replaced
3312:b145b32294ff 3313:509d2981ffea
396 (defun show-gc-stats () 396 (defun show-gc-stats ()
397 "Show statistics about garbage collection cycles." 397 "Show statistics about garbage collection cycles."
398 (interactive) 398 (interactive)
399 (let ((buffer "*garbage collection statistics*") 399 (let ((buffer "*garbage collection statistics*")
400 (plist (gc-stats)) 400 (plist (gc-stats))
401 (fmt "%-9s %10s %10s %10s %10s %10s\n")) 401 (fmt "%-9s %16s %12s %12s %12s %12s\n"))
402 (flet ((plist-get-stat (category field) 402 (flet ((plist-get-stat (category field)
403 (or (plist-get plist (intern (concat category field))) 403 (let ((stat (plist-get plist (intern (concat category field)))))
404 "-")) 404 (if stat
405 (format "%.0f" stat)
406 "-")))
405 (show-stats (category) 407 (show-stats (category)
406 (princ (format fmt category 408 (princ (format fmt category
407 (plist-get-stat category "-total") 409 (plist-get-stat category "-total")
408 (plist-get-stat category "-in-last-gc") 410 (plist-get-stat category "-in-last-gc")
409 (plist-get-stat category "-in-this-gc") 411 (plist-get-stat category "-in-this-gc")
410 (plist-get-stat category "-in-last-cycle") 412 (plist-get-stat category "-in-last-cycle")
411 (plist-get-stat category "-in-this-cycle"))))) 413 (plist-get-stat category "-in-this-cycle")))))
412 (with-output-to-temp-buffer buffer 414 (with-output-to-temp-buffer buffer
413 (save-excursion 415 (save-excursion
414 (set-buffer buffer) 416 (set-buffer buffer)
415 (princ (format "%s %s\n" "Current phase" (plist-get plist 'phase))) 417 (princ (format "%s %g\n" "Current phase" (plist-get plist 'phase)))
416 (princ (make-string 64 ?-)) 418 (princ (make-string 78 ?-))
417 (princ "\n") 419 (princ "\n")
418 (princ (format fmt "stat" "total" "last-gc" "this-gc" 420 (princ (format fmt "stat" "total" "last-gc" "this-gc"
419 "last-cycle" "this-cylce")) 421 "last-cycle" "this-cylce"))
420 (princ (make-string 64 ?-)) 422 (princ (make-string 78 ?-))
421 (princ "\n") 423 (princ "\n")
422 (show-stats "n-gc") 424 (show-stats "n-gc")
423 (show-stats "n-cycles") 425 (show-stats "n-cycles")
424 (show-stats "enqueued") 426 (show-stats "enqueued")
425 (show-stats "dequeued") 427 (show-stats "dequeued")
426 (show-stats "repushed") 428 (show-stats "repushed")
427 (show-stats "enqueued2") 429 (show-stats "enqueued2")
428 (show-stats "dequeued2") 430 (show-stats "dequeued2")
429 (show-stats "finalized") 431 (show-stats "finalized")
430 (show-stats "freed") 432 (show-stats "freed")
431 (princ (make-string 64 ?-)) 433 (plist-get plist 'n-gc-total))))))
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)))))