Mercurial > hg > xemacs-beta
diff lisp/diagnose.el @ 3092:141c2920ea48
[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 |
line wrap: on
line diff
--- a/lisp/diagnose.el Thu Nov 24 22:51:25 2005 +0000 +++ b/lisp/diagnose.el Fri Nov 25 01:42:08 2005 +0000 @@ -142,7 +142,7 @@ (princ "\n") (map-plist #'(lambda (stat num) (when (string-match - "\\(.*\\)-storage\\(-additional\\)?$" + "\\(.*\\)-storage\\$" (symbol-name stat)) (incf total num) (princ (format fmt @@ -237,10 +237,6 @@ (setq begin (point)) (princ "Allocated with lisp allocator:\n") (show-stats "\\(.*\\)-storage$") - (princ "\n\n") - (setq begin (point)) - (princ "Allocated additionally:\n") - (show-stats "\\(.*\\)-storage-additional$") (princ (format "\n\ngrand total: %s\n" grandtotal))) grandtotal)))) @@ -253,10 +249,9 @@ (page-size (first stats)) (heap-sects (second stats)) (used-plhs (third stats)) - (unmanaged-plhs (fourth stats)) - (free-plhs (fifth stats)) - (globals (sixth stats)) - (mc-malloced-bytes (seventh stats))) + (free-plhs (fourth stats)) + (globals (fifth stats)) + (mc-malloced-bytes (sixth stats))) (with-output-to-temp-buffer "*memory usage*" (flet ((print-used-plhs (text plhs) (let ((sum-n-pages 0) @@ -372,9 +367,6 @@ (print-used-plhs "USED HEAP" used-plhs) (princ "\n\n") - (print-used-plhs "UNMANAGED HEAP" unmanaged-plhs) - (princ "\n\n") - (print-free-plhs "FREE HEAP" free-plhs) (princ "\n\n") @@ -399,3 +391,50 @@ (princ (format fmt "grand total" mc-malloced-bytes))) (+ mc-malloced-bytes))))) + + +(defun show-gc-stats () + "Show statistics about garbage collection cycles." + (interactive) + (let ((buffer "*garbage collection statistics*") + (plist (gc-stats)) + (fmt "%-9s %10s %10s %10s %10s %10s\n")) + (flet ((plist-get-stat (category field) + (or (plist-get plist (intern (concat category field))) + "-")) + (show-stats (category) + (princ (format fmt category + (plist-get-stat category "-total") + (plist-get-stat category "-in-last-gc") + (plist-get-stat category "-in-this-gc") + (plist-get-stat category "-in-last-cycle") + (plist-get-stat category "-in-this-cycle"))))) + (with-output-to-temp-buffer buffer + (save-excursion + (set-buffer buffer) + (princ (format "%s %s\n" "Current phase" (plist-get plist 'phase))) + (princ (make-string 64 ?-)) + (princ "\n") + (princ (format fmt "stat" "total" "last-gc" "this-gc" + "last-cycle" "this-cylce")) + (princ (make-string 64 ?-)) + (princ "\n") + (show-stats "n-gc") + (show-stats "n-cycles") + (show-stats "enqueued") + (show-stats "dequeued") + (show-stats "repushed") + (show-stats "enqueued2") + (show-stats "dequeued2") + (show-stats "finalized") + (show-stats "freed") + (princ (make-string 64 ?-)) + (princ "\n") + (princ (format fmt "explicitly" + "freed:" + (plist-get-stat "explicitly" "-freed") + "tried:" + (plist-get-stat "explicitly" "-tried-freed") + ""))) + + (plist-get plist 'n-gc-total)))))