comparison lisp/diagnose.el @ 2775:05d62157e048

[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
comparison
equal deleted inserted replaced
2774:d72eefd1305a 2775:05d62157e048
137 (setq begin (point)) 137 (setq begin (point))
138 (princ (format fmt "object" "storage")) 138 (princ (format fmt "object" "storage"))
139 (princ (make-string 40 ?-)) 139 (princ (make-string 40 ?-))
140 (princ "\n") 140 (princ "\n")
141 (map-plist #'(lambda (stat num) 141 (map-plist #'(lambda (stat num)
142 (when (string-match "\\(.*\\)-storage$" 142 (when (string-match
143 (symbol-name stat)) 143 "\\(.*\\)-storage\\(-additional\\)?$"
144 (symbol-name stat))
144 (incf total num) 145 (incf total num)
145 (princ (format fmt 146 (princ (format fmt
146 (match-string 1 (symbol-name stat)) 147 (match-string 1 (symbol-name stat))
147 num))) 148 num)))
148 (when (eq stat 'long-strings-total-length) 149 (when (eq stat 'long-strings-total-length)
162 (point))) 163 (point)))
163 164
164 (princ (format "\n\ngrand total: %s\n" grandtotal))) 165 (princ (format "\n\ngrand total: %s\n" grandtotal)))
165 grandtotal)))) 166 grandtotal))))
166 167
168
169 (defun show-lrecord-stats ()
170 "Show statistics about lrecord usage in XEmacs."
171 (interactive)
172 (garbage-collect)
173 (let ((buffer "*lrecord statistics*")
174 (plist (lrecord-stats))
175 (fmt "%-30s%10s%10s\n")
176 (grandtotal 0)
177 begin)
178 (flet ((show-stats (match-string)
179 (princ (format fmt "object" "count" "storage"))
180 (princ (make-string 50 ?-))
181 (princ "\n")
182 (let ((total-use 0)
183 (total-use-overhead 0)
184 (total-count 0))
185 (map-plist
186 #'(lambda (stat num)
187 (when (string-match match-string
188 (symbol-name stat))
189 (let ((storage-use num)
190 (storage-use-overhead
191 (plist-get
192 plist
193 (intern (concat (match-string 1 (symbol-name stat))
194 "-storage-including-overhead"))))
195 (storage-count
196 (or (plist-get
197 plist
198 (intern
199 (concat (match-string 1 (symbol-name stat))
200 "s-used")))
201 (plist-get
202 plist
203 (intern
204 (concat (match-string 1 (symbol-name stat))
205 "es-used")))
206 (plist-get
207 plist
208 (intern
209 (concat (match-string 1 (symbol-name stat))
210 "-used"))))))
211 (incf total-use storage-use)
212 (incf total-use-overhead (if storage-use-overhead
213 storage-use-overhead
214 storage-use))
215 (incf total-count storage-count)
216 (princ (format fmt
217 (match-string 1 (symbol-name stat))
218 storage-count storage-use)))))
219 plist)
220 (princ "\n")
221 (princ (format fmt "total"
222 total-count total-use-overhead))
223 (incf grandtotal total-use-overhead)
224 (sort-numeric-fields -1
225 (save-excursion
226 (goto-char begin)
227 (forward-line 2)
228 (point))
229 (save-excursion
230 (forward-line -2)
231 (point))))))
232 (with-output-to-temp-buffer buffer
233 (save-excursion
234 (set-buffer buffer)
235 (setq begin (point))
236 (princ "Allocated with new allocator:\n")
237 (show-stats "\\(.*\\)-storage$")
238 (princ "\n\n")
239 (setq begin (point))
240 (princ "Allocated additionally:\n")
241 (show-stats "\\(.*\\)-storage-additional$")
242 (princ (format "\n\ngrand total: %s\n" grandtotal)))
243 grandtotal))))
244
167 245
168 (defun show-mc-alloc-memory-usage () 246 (defun show-mc-alloc-memory-usage ()
169 "Show statistics about memory usage of the new allocator." 247 "Show statistics about memory usage of the new allocator."
170 (interactive) 248 (interactive)
171 (garbage-collect) 249 (garbage-collect)