Mercurial > hg > xemacs-beta

diff lisp/diagnose.el @ 2775:05d62157e048

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-05-15 16:37:52 by crestani] New allocator improvements lisp/ChangeLog addition: 2005-05-15 Marcus Crestani <crestani@xemacs.org> * diagnose.el: Lrecord and string data statistics. * diagnose.el (show-memory-usage): Add output for additional lrecord statistics (currently only string data). * diagnose.el (show-lrecord-stats): New. Print detailed lrecord statistics. src/ChangeLog addition: 2005-05-15 Marcus Crestani <crestani@xemacs.org> * alloc.c: Add string data statistics. * alloc.c (dec_lrecord_stats): Use size of lrecord for statistics and cons counter bookkeeping. * alloc.c (finalize_string): Add string data statistics. * alloc.c (make_uninit_string): Add string data statistics. * alloc.c (make_string_nocopy): Add string data statistics. * alloc.c (kkcc_marking): Move break out of #ifdef. * alloc.c (Flrecord_stats): New. Collect lrecord statistics. * alloc.c (Fgarbage_collect): Use Flrecord_stats. * alloc.c (syms_of_alloc): Add Flrecord_stats. * dumper.c: Fix hash table. * dumper.c (pdump_make_hash): Fix hash table. * dumper.c (pdump_get_mc_addr): Fix hash table. * dumper.c (pdump_put_mc_addr): Fix hash table. * dumper.c (pdump_reloc_one_mc): Fix indentation. * dumper.c (pdump_load_finish): Add lrecord statistics bookkeeping. * lrecord.h: Add string data statistics. * mc-alloc.c (remove_cell): Lrecord statistics, fix indentation. * mule-charset.c: Marking through *_unicode_description not needed. * symbols.c (init_symbols_once_early): Bump lrecord statistics. * window.c: Marking through line_start_cache not needed. * xemacs.def.in.in: Fix typo.
author crestani
date Sun, 15 May 2005 16:38:14 +0000
parents 6fa9919a9a0b
children 876730d84b73
line wrap: on
line diff
--- a/lisp/diagnose.el	Sat May 14 21:50:55 2005 +0000
+++ b/lisp/diagnose.el	Sun May 15 16:38:14 2005 +0000
@@ -139,8 +139,9 @@
 	    (princ (make-string 40 ?-))
 	    (princ "\n")
 	    (map-plist #'(lambda (stat num)
-			   (when (string-match "\\(.*\\)-storage$"
-					       (symbol-name stat))
+			   (when (string-match 
+				  "\\(.*\\)-storage\\(-additional\\)?$"
+				  (symbol-name stat))
 			     (incf total num)
 			     (princ (format fmt
 					    (match-string 1 (symbol-name stat))
@@ -165,6 +166,83 @@
 	grandtotal))))
 
 
+(defun show-lrecord-stats ()
+  "Show statistics about lrecord usage in XEmacs."
+  (interactive)
+  (garbage-collect)
+  (let ((buffer "*lrecord statistics*")
+	(plist (lrecord-stats))
+	(fmt "%-30s%10s%10s\n")
+	(grandtotal 0)
+	begin)
+  (flet ((show-stats (match-string)
+	(princ (format fmt "object" "count" "storage"))
+	(princ (make-string 50 ?-))
+	(princ "\n")
+	(let ((total-use 0)
+	      (total-use-overhead 0)
+	      (total-count 0))
+	  (map-plist 
+	   #'(lambda (stat num)
+	       (when (string-match match-string
+				   (symbol-name stat))
+		 (let ((storage-use num)
+		       (storage-use-overhead 
+			(plist-get 
+			 plist 
+			 (intern (concat (match-string 1 (symbol-name stat))
+					 "-storage-including-overhead"))))
+		       (storage-count 
+			(or (plist-get 
+			     plist 
+			     (intern 
+			      (concat (match-string 1 (symbol-name stat)) 
+				      "s-used")))
+			    (plist-get 
+			     plist 
+			     (intern 
+			      (concat (match-string 1 (symbol-name stat))
+				      "es-used")))
+			    (plist-get 
+			     plist 
+			     (intern 
+			      (concat (match-string 1 (symbol-name stat))
+				      "-used"))))))
+		   (incf total-use storage-use)
+		   (incf total-use-overhead (if storage-use-overhead 
+						storage-use-overhead 
+					      storage-use))
+		   (incf total-count storage-count)
+		   (princ (format fmt
+				  (match-string 1 (symbol-name stat)) 
+				  storage-count storage-use)))))
+	   plist)
+	  (princ "\n")
+	  (princ (format fmt "total" 
+			 total-count total-use-overhead))
+	  (incf grandtotal total-use-overhead)
+	  (sort-numeric-fields -1
+			       (save-excursion
+				 (goto-char begin)
+				 (forward-line 2)
+				 (point))
+			       (save-excursion
+				 (forward-line -2)
+				 (point))))))
+    (with-output-to-temp-buffer buffer
+      (save-excursion
+	(set-buffer buffer)
+	(setq begin (point))
+	(princ "Allocated with new 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))))
+  
+
 (defun show-mc-alloc-memory-usage ()
   "Show statistics about memory usage of the new allocator."
   (interactive)