Mercurial > hg > xemacs-beta
changeset 787:242b62e9fc59
[xemacs-hg @ 2002-03-20 10:20:48 by ben]
debug -> diagnose
| author | ben |
|---|---|
| date | Wed, 20 Mar 2002 10:21:23 +0000 |
| parents | 381a409ad3c3 |
| children | 026c5bf9c134 |
| files | lisp/ChangeLog lisp/debug.el lisp/diagnose.el lisp/dumped-lisp.el |
| diffstat | 4 files changed, 132 insertions(+), 126 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Mar 20 10:15:59 2002 +0000 +++ b/lisp/ChangeLog Wed Mar 20 10:21:23 2002 +0000 @@ -1,3 +1,9 @@ +2002-03-20 Ben Wing <ben@xemacs.org> + + * dumped-lisp.el (preloaded-file-list): debug.el -> diagnose.el. + * diagnose.el: Renamed from debug.el because of existing debug.el + in xemacs-base. + 2002-03-18 Ben Wing <ben@xemacs.org> * dumped-lisp.el (preloaded-file-list): Add debug.el.
--- a/lisp/debug.el Wed Mar 20 10:15:59 2002 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,125 +0,0 @@ -;;; debug.el --- routines for debugging problems in XEmacs - -;; Copyright (C) 2002 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: dumped - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - - -(defun show-memory-usage () - "Show statistics about memory usage of various sorts in XEmacs." - (interactive) - (garbage-collect) - (flet ((show-foo-stats (objtypename objlist memfun) - (let* ((hash (make-hash-table)) - (first t) - types fmt - (objnamelen 25) - (linelen objnamelen) - (totaltotal 0)) - (dolist (obj objlist) - (let ((total 0) - (stats (funcall memfun obj))) - (loop for (type . num) in stats while type do - (puthash type (+ num (or (gethash type hash) 0)) hash) - (incf total num) - (if first (push type types))) - (incf totaltotal total) - (when first - (setq types (nreverse types)) - (setq fmt (concat - (format "%%-%ds" objnamelen) - (mapconcat - #'(lambda (type) - (let ((fieldlen - (max 8 (+ 2 (length - (symbol-name type)))))) - (incf linelen fieldlen) - (format "%%%ds" fieldlen))) - types "") - (progn (incf linelen 8) "%8s\n"))) - (princ "\n") - (princ (apply 'format fmt objtypename - (append types (list 'total)))) - (princ (make-string linelen ?-)) - (princ "\n")) - (let ((objname (format "%s" obj))) - (princ (apply 'format fmt (substring objname 0 - (min (length objname) - (1- objnamelen))) - (nconc (mapcar #'(lambda (type) - (cdr (assq type stats))) - types) - (list total))))) - (setq first nil))) - (princ "\n") - (princ (apply 'format fmt "total" - (nconc (mapcar #'(lambda (type) - (gethash type hash)) - types) - (list totaltotal)))) - totaltotal))) - - (let ((grandtotal 0)) - (with-output-to-temp-buffer "*memory usage*" - (when-fboundp 'charset-list - (incf grandtotal - (show-foo-stats 'charset (charset-list) - #'charset-memory-usage)) - (princ "\n")) - (incf grandtotal - (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage)) - (princ "\n") - (incf grandtotal - (show-foo-stats 'window (mapcan #'(lambda (fr) - (window-list fr t)) - (frame-list)) - #'window-memory-usage)) - (princ "\n") - (let ((total 0) - (fmt "%-30s%10s\n")) - (princ (format fmt "object" "storage")) - (princ (make-string 40 ?-)) - (princ "\n") - (map-plist #'(lambda (stat num) - (when (string-match "\\(.*\\)-storage$" - (symbol-name stat)) - (incf total num) - (princ (format fmt - (match-string 1 (symbol-name stat)) - num))) - (when (eq stat 'long-strings-total-length) - (incf total num) - (princ (format fmt stat num)))) - (sixth (garbage-collect))) - (princ "\n") - (princ (format fmt "total" total)) - (incf grandtotal total)) - - (princ (format "\n\ngrand total: %s\n" grandtotal)) - grandtotal))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/diagnose.el Wed Mar 20 10:21:23 2002 +0000 @@ -0,0 +1,125 @@ +;;; debug.el --- routines for debugging problems in XEmacs + +;; Copyright (C) 2002 Ben Wing. + +;; Maintainer: XEmacs Development Team +;; Keywords: dumped + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; This file is dumped with XEmacs. + +;;; Code: + + +(defun show-memory-usage () + "Show statistics about memory usage of various sorts in XEmacs." + (interactive) + (garbage-collect) + (flet ((show-foo-stats (objtypename objlist memfun) + (let* ((hash (make-hash-table)) + (first t) + types fmt + (objnamelen 25) + (linelen objnamelen) + (totaltotal 0)) + (dolist (obj objlist) + (let ((total 0) + (stats (funcall memfun obj))) + (loop for (type . num) in stats while type do + (puthash type (+ num (or (gethash type hash) 0)) hash) + (incf total num) + (if first (push type types))) + (incf totaltotal total) + (when first + (setq types (nreverse types)) + (setq fmt (concat + (format "%%-%ds" objnamelen) + (mapconcat + #'(lambda (type) + (let ((fieldlen + (max 8 (+ 2 (length + (symbol-name type)))))) + (incf linelen fieldlen) + (format "%%%ds" fieldlen))) + types "") + (progn (incf linelen 8) "%8s\n"))) + (princ "\n") + (princ (apply 'format fmt objtypename + (append types (list 'total)))) + (princ (make-string linelen ?-)) + (princ "\n")) + (let ((objname (format "%s" obj))) + (princ (apply 'format fmt (substring objname 0 + (min (length objname) + (1- objnamelen))) + (nconc (mapcar #'(lambda (type) + (cdr (assq type stats))) + types) + (list total))))) + (setq first nil))) + (princ "\n") + (princ (apply 'format fmt "total" + (nconc (mapcar #'(lambda (type) + (gethash type hash)) + types) + (list totaltotal)))) + totaltotal))) + + (let ((grandtotal 0)) + (with-output-to-temp-buffer "*memory usage*" + (when-fboundp 'charset-list + (incf grandtotal + (show-foo-stats 'charset (charset-list) + #'charset-memory-usage)) + (princ "\n")) + (incf grandtotal + (show-foo-stats 'buffer (buffer-list) #'buffer-memory-usage)) + (princ "\n") + (incf grandtotal + (show-foo-stats 'window (mapcan #'(lambda (fr) + (window-list fr t)) + (frame-list)) + #'window-memory-usage)) + (princ "\n") + (let ((total 0) + (fmt "%-30s%10s\n")) + (princ (format fmt "object" "storage")) + (princ (make-string 40 ?-)) + (princ "\n") + (map-plist #'(lambda (stat num) + (when (string-match "\\(.*\\)-storage$" + (symbol-name stat)) + (incf total num) + (princ (format fmt + (match-string 1 (symbol-name stat)) + num))) + (when (eq stat 'long-strings-total-length) + (incf total num) + (princ (format fmt stat num)))) + (sixth (garbage-collect))) + (princ "\n") + (princ (format fmt "total" total)) + (incf grandtotal total)) + + (princ (format "\n\ngrand total: %s\n" grandtotal)) + grandtotal))))