Mercurial > hg > xemacs-beta
annotate lisp/diagnose.el @ 5556:a142ad1a9140
Use dlsym() in preference to NSLookupSymbolInModule() on Darwin, if available.
ChangeLog addition:
2011-08-24 Aidan Kehoe <kehoea@parhasard.net>
* configure.ac:
On OS X, if dlopen() is available in dlfcn.h, use it in preference
to dyld; the latter API is deprecated.
Move DLSYM_NEEDS_UNDERSCORE together with HAVE_DLYD, it's not
needed if the dlsym() and dlopen() APIs are being used.
Define REALPATH_CORRECTS_CASE, DEFAULT_FILE_SYSTEM_IGNORE_CASE in
this file, don't define them in terms of HAVE_DYLD in
src/config.h.in.
* configure: Regenerate.
src/ChangeLog addition:
2011-08-24 Aidan Kehoe <kehoea@parhasard.net>
* config.h.in:
Move REALPATH_CORRECTS_CASE, DEFAULT_FILE_SYSTEM_IGNORE_CASE to
../configure.ac rather than implementing them in terms of
HAVE_DYLD here.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 24 Aug 2011 23:41:29 +0100 |
| parents | ac37a5f7e5be |
| children | 3bc58dc9d688 |
| rev | line source |
|---|---|
| 2618 | 1 ;;; diagnose.el --- routines for debugging problems in XEmacs |
| 787 | 2 |
|
5059
c8f90d61dcf3
fix memory usage stats to include pdumped objects
Ben Wing <ben@xemacs.org>
parents:
4103
diff
changeset
|
3 ;; Copyright (C) 2002, 2010 Ben Wing. |
| 787 | 4 |
| 5 ;; Maintainer: XEmacs Development Team | |
| 6 ;; Keywords: dumped | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
13 ;; option) any later version. |
| 787 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
18 ;; for more details. |
| 787 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5230
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 787 | 22 |
| 23 ;;; Synched up with: Not in FSF. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;; This file is dumped with XEmacs. | |
| 28 | |
| 29 ;;; Code: | |
| 30 | |
| 31 | |
| 32 (defun show-memory-usage () | |
| 33 "Show statistics about memory usage of various sorts in XEmacs." | |
| 34 (interactive) | |
| 35 (garbage-collect) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
36 (flet ((show-foo-stats (objtypename statname-plist cleanfun objlist |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
37 &optional objnamelen) |
| 787 | 38 (let* ((hash (make-hash-table)) |
| 39 (first t) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
40 types origtypes fmt |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
41 (objnamelen (or objnamelen 25)) |
| 787 | 42 (linelen objnamelen) |
| 43 (totaltotal 0)) | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
44 (loop for obj in objlist do |
| 787 | 45 (let ((total 0) |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
46 (stats (object-memory-usage obj))) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
47 ;; Pop off the slice describing the object itself's |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
48 ;; memory |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
49 (while (and stats (not (eq t (pop stats))))) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
50 ;; Pop off the slice describing the associated |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
51 ;; non-Lisp-Object memory from the allocation |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
52 ;; perspective, so we can get to the slice describing |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
53 ;; the memory grouped by type |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
54 (while (and stats (pop stats))) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
55 |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
56 (loop for (type . num) in (remq t stats) while type do |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
57 (if first (push type origtypes)) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
58 (setq type (getf statname-plist type type)) |
| 787 | 59 (puthash type (+ num (or (gethash type hash) 0)) hash) |
| 60 (incf total num) | |
| 61 (if first (push type types))) | |
| 62 (incf totaltotal total) | |
| 63 (when first | |
| 64 (setq types (nreverse types)) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
65 (setq origtypes (nreverse origtypes)) |
| 787 | 66 (setq fmt (concat |
| 67 (format "%%-%ds" objnamelen) | |
| 68 (mapconcat | |
| 69 #'(lambda (type) | |
| 70 (let ((fieldlen | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
71 (max 7 (+ 2 (length |
| 787 | 72 (symbol-name type)))))) |
| 73 (incf linelen fieldlen) | |
| 74 (format "%%%ds" fieldlen))) | |
| 75 types "") | |
| 2618 | 76 (progn (incf linelen 9) "%9s\n"))) |
| 787 | 77 (princ "\n") |
| 78 (princ (apply 'format fmt objtypename | |
| 79 (append types (list 'total)))) | |
| 80 (princ (make-string linelen ?-)) | |
| 81 (princ "\n")) | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
82 (let ((objname (format "%s" (funcall cleanfun obj)))) |
| 787 | 83 (princ (apply 'format fmt (substring objname 0 |
| 84 (min (length objname) | |
| 85 (1- objnamelen))) | |
| 86 (nconc (mapcar #'(lambda (type) | |
| 87 (cdr (assq type stats))) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
88 origtypes) |
| 787 | 89 (list total))))) |
| 90 (setq first nil))) | |
| 91 (princ "\n") | |
| 92 (princ (apply 'format fmt "total" | |
| 93 (nconc (mapcar #'(lambda (type) | |
| 94 (gethash type hash)) | |
| 95 types) | |
| 96 (list totaltotal)))) | |
| 97 totaltotal))) | |
| 98 | |
| 2618 | 99 (let ((grandtotal 0) |
| 100 (buffer "*memory usage*") | |
| 101 begin) | |
| 102 (with-output-to-temp-buffer buffer | |
| 103 (save-excursion | |
| 104 (set-buffer buffer) | |
| 105 (when-fboundp 'charset-list | |
| 106 (setq begin (point)) | |
| 107 (incf grandtotal | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
108 (show-foo-stats 'charset nil 'charset-name |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
109 (mapcar 'get-charset (charset-list)))) |
| 3066 | 110 (when-fboundp 'sort-numeric-fields |
| 111 (sort-numeric-fields -1 | |
| 112 (save-excursion | |
| 113 (goto-char begin) | |
| 114 (forward-line 2) | |
| 115 (point)) | |
| 116 (save-excursion | |
| 117 (forward-line -2) | |
| 118 (point)))) | |
| 2618 | 119 (princ "\n")) |
| 120 (setq begin (point)) | |
| 121 (incf grandtotal | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
122 (show-foo-stats 'buffer nil 'buffer-name (buffer-list))) |
| 3066 | 123 (when-fboundp 'sort-numeric-fields |
| 124 (sort-numeric-fields -1 | |
| 125 (save-excursion | |
| 126 (goto-char begin) | |
| 127 (forward-line 3) | |
| 128 (point)) | |
| 129 (save-excursion | |
| 130 (forward-line -2) | |
| 131 (point)))) | |
| 2618 | 132 (princ "\n") |
| 133 (setq begin (point)) | |
| 787 | 134 (incf grandtotal |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
135 (show-foo-stats 'window |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
136 '(line-start-cache line-st. |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
137 face-cache face |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
138 glyph-cache glyph |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
139 redisplay-structs redisplay |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
140 scrollbar-instances scrollbar |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
141 window-mirror mirror) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
142 #'(lambda (x) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
143 (buffer-name (window-buffer x))) |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
144 (mapcan #'(lambda (fr) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5059
diff
changeset
|
145 (window-list fr t)) |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
146 (frame-list)) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
147 16)) |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5230
diff
changeset
|
148 (when-fboundp 'sort-numeric-fields |
| 4103 | 149 (sort-numeric-fields -1 |
| 150 (save-excursion | |
| 151 (goto-char begin) | |
| 152 (forward-line 3) | |
| 153 (point)) | |
| 154 (save-excursion | |
| 155 (forward-line -2) | |
| 156 (point)))) | |
| 787 | 157 (princ "\n") |
| 2618 | 158 (let ((total 0) |
| 159 (fmt "%-30s%10s\n")) | |
| 160 (setq begin (point)) | |
| 161 (princ (format fmt "object" "storage")) | |
| 162 (princ (make-string 40 ?-)) | |
| 163 (princ "\n") | |
| 164 (map-plist #'(lambda (stat num) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
165 (when (and |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
166 (not |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
167 (string-match |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
168 "\\(.*\\)-ancillary-storage$" |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
169 (symbol-name stat))) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
170 (string-match |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
171 "\\(.*\\)-storage$" |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
172 (symbol-name stat))) |
| 2618 | 173 (incf total num) |
| 174 (princ (format fmt | |
| 175 (match-string 1 (symbol-name stat)) | |
| 176 num))) | |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
177 ) |
| 2618 | 178 (sixth (garbage-collect))) |
| 179 (princ "\n") | |
| 180 (princ (format fmt "total" total)) | |
| 181 (incf grandtotal total)) | |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5230
diff
changeset
|
182 (when-fboundp 'sort-numeric-fields |
| 4103 | 183 (sort-numeric-fields -1 |
| 184 (save-excursion | |
| 185 (goto-char begin) | |
| 186 (forward-line 2) | |
| 187 (point)) | |
| 188 (save-excursion | |
| 189 (forward-line -2) | |
| 190 (point)))) | |
| 787 | 191 |
| 2618 | 192 (princ (format "\n\ngrand total: %s\n" grandtotal))) |
| 787 | 193 grandtotal)))) |
| 2720 | 194 |
| 195 | |
| 3041 | 196 (defun show-object-memory-usage-stats () |
| 3888 | 197 "Show statistics about object memory usage in XEmacs." |
| 2775 | 198 (interactive) |
| 199 (garbage-collect) | |
| 3041 | 200 (let ((buffer "*object memory usage statistics*") |
| 201 (plist (object-memory-usage-stats)) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
202 (fmt "%-28s%10s%10s%10s%10s%10s\n") |
| 2775 | 203 (grandtotal 0) |
| 204 begin) | |
| 205 (flet ((show-stats (match-string) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
206 (princ (format "%28s%10s%40s\n" "" "" |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
207 "--------------storage---------------")) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
208 (princ (format fmt "object" "count" "object" "overhead" |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
209 "non-Lisp" "ancillary")) |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
210 (princ (make-string 78 ?-)) |
| 2775 | 211 (princ "\n") |
| 212 (let ((total-use 0) | |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
213 (total-non-lisp-use 0) |
| 2775 | 214 (total-use-overhead 0) |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
215 (total-use-with-overhead 0) |
| 2775 | 216 (total-count 0)) |
| 217 (map-plist | |
| 218 #'(lambda (stat num) | |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
219 (let ((symmatch |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
220 (and (string-match match-string (symbol-name stat)) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
221 (match-string 1 (symbol-name stat))))) |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
222 (when (and symmatch |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
223 (or (< (length symmatch) 9) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
224 (not (equal (substring symmatch -9) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
225 "-non-lisp"))) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
226 (or (< (length symmatch) 15) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
227 (not (equal (substring symmatch -15) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
228 "-lisp-ancillary")))) |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
229 (let* ((storage-use num) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
230 (storage-use-overhead |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
231 (or (plist-get |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
232 plist |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
233 (intern (concat symmatch |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
234 "-storage-overhead"))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
235 0)) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
236 (storage-use-with-overhead |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
237 (or (plist-get |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
238 plist |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
239 (intern (concat |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
240 symmatch |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
241 "-storage-including-overhead"))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
242 (+ storage-use storage-use-overhead))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
243 (storage-use-overhead |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
244 (- storage-use-with-overhead storage-use)) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
245 (non-lisp-storage |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
246 (or (plist-get |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
247 plist |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
248 (intern (concat symmatch |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
249 "-non-lisp-storage"))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
250 0)) |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
251 (lisp-ancillary-storage |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
252 (or (plist-get |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
253 plist |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
254 (intern (concat symmatch |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
255 "-lisp-ancillary-storage"))) |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
256 0)) |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
257 (storage-count |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
258 (or (loop for str in '("s-used" "es-used" "-used") |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
259 for val = (plist-get |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
260 plist |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
261 (intern |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
262 (concat symmatch str))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
263 if val |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
264 return val) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
265 (plist-get |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
266 plist |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
267 (intern |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
268 (concat (substring symmatch 0 -1) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
269 "ies-used"))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
270 ))) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
271 (incf total-use storage-use) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
272 (incf total-use-overhead storage-use-overhead) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
273 (incf total-use-with-overhead storage-use-with-overhead) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
274 (incf total-non-lisp-use non-lisp-storage) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
275 (incf total-count (or storage-count 0)) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
276 (and (> storage-use-with-overhead 0) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
277 (princ (format fmt symmatch |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
278 (or storage-count "unknown") |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
279 storage-use |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
280 storage-use-overhead |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
281 non-lisp-storage |
|
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
282 lisp-ancillary-storage))))))) |
| 2775 | 283 plist) |
| 284 (princ "\n") | |
| 285 (princ (format fmt "total" | |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
286 total-count total-use total-use-overhead |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
287 total-non-lisp-use "")) |
|
5160
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
288 (incf grandtotal total-use-with-overhead) |
|
ab9ee10a53e4
fix various problems with allocation statistics, track overhead properly
Ben Wing <ben@xemacs.org>
parents:
5158
diff
changeset
|
289 (incf grandtotal total-non-lisp-use) |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5230
diff
changeset
|
290 (when-fboundp 'sort-numeric-fields |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
291 (sort-numeric-fields -4 |
| 4103 | 292 (save-excursion |
| 293 (goto-char begin) | |
|
5170
5ddbab03b0e6
various fixes to memory-usage stats
Ben Wing <ben@xemacs.org>
parents:
5160
diff
changeset
|
294 (forward-line 4) |
| 4103 | 295 (point)) |
| 296 (save-excursion | |
| 297 (forward-line -2) | |
| 298 (point))))))) | |
| 2775 | 299 (with-output-to-temp-buffer buffer |
| 300 (save-excursion | |
| 301 (set-buffer buffer) | |
| 302 (setq begin (point)) | |
|
5158
9e0b43d3095c
more cleanups to object-memory-usage stuff
Ben Wing <ben@xemacs.org>
parents:
5157
diff
changeset
|
303 (princ "Allocated with lisp allocator or related:\n") |
| 2775 | 304 (show-stats "\\(.*\\)-storage$") |
| 305 (princ (format "\n\ngrand total: %s\n" grandtotal))) | |
| 306 grandtotal)))) | |
| 307 | |
| 308 | |
| 2720 | 309 (defun show-mc-alloc-memory-usage () |
| 310 "Show statistics about memory usage of the new allocator." | |
| 311 (interactive) | |
| 312 (garbage-collect) | |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5230
diff
changeset
|
313 (if-fboundp 'mc-alloc-memory-usage |
| 4103 | 314 (let* ((stats (mc-alloc-memory-usage)) |
| 315 (page-size (first stats)) | |
| 316 (heap-sects (second stats)) | |
| 317 (used-plhs (third stats)) | |
| 318 (free-plhs (fourth stats)) | |
| 319 (globals (fifth stats)) | |
| 320 (mc-malloced-bytes (sixth stats))) | |
| 321 (with-output-to-temp-buffer "*mc-alloc memory usage*" | |
| 322 (flet ((print-used-plhs (text plhs) | |
| 323 (let ((sum-n-pages 0) | |
| 324 (sum-used-n-cells 0) | |
| 325 (sum-used-space 0) | |
| 326 (sum-used-total 0) | |
| 327 (sum-total-n-cells 0) | |
| 328 (sum-total-space 0) | |
| 329 (sum-total-total 0) | |
| 330 (fmt "%7s%7s|%7s%9s%9s%4s|%7s%9s%9s%4s|%4s\n")) | |
| 331 (princ (format "%-14s|%-29s|%-29s|\n" | |
| 332 text | |
| 333 " currently in use" | |
| 334 " total available")) | |
| 335 (princ (format fmt "cell-sz" "#pages" | |
| 336 "#cells" "space" "total" "% " | |
| 337 "#cells" "space" "total" "% " "% ")) | |
| 338 (princ (make-string 79 ?-)) | |
| 339 (princ "\n") | |
| 340 (while plhs | |
| 341 (let* ((elem (car plhs)) | |
| 342 (cell-size (first elem)) | |
| 343 (n-pages (second elem)) | |
| 344 (used-n-cells (third elem)) | |
| 345 (used-space (fourth elem)) | |
| 346 (used-total (if (zerop cell-size) | |
| 347 (sixth elem) | |
| 348 (* cell-size used-n-cells))) | |
| 349 (used-eff (floor (if (not (zerop used-total)) | |
| 350 (* (/ (* used-space 1.0) | |
| 351 (* used-total 1.0)) | |
| 352 100.0) | |
| 353 0))) | |
| 354 (total-n-cells (fifth elem)) | |
| 355 (total-space (if (zerop cell-size) | |
| 356 used-space | |
| 357 (* cell-size total-n-cells))) | |
| 358 (total-total (sixth elem)) | |
| 359 (total-eff (floor (if (not (zerop total-total)) | |
| 360 (* (/ (* total-space 1.0) | |
| 361 (* total-total 1.0)) | |
| 362 100.0) | |
| 363 0))) | |
| 364 (eff (floor (if (not (zerop total-total)) | |
| 365 (* (/ (* used-space 1.0) | |
| 366 (* total-total 1.0)) | |
| 367 100.0) | |
| 368 0)))) | |
| 369 (princ (format fmt | |
| 370 cell-size n-pages used-n-cells used-space | |
| 371 used-total used-eff total-n-cells | |
| 372 total-space total-total total-eff eff)) | |
| 373 (incf sum-n-pages n-pages) | |
| 374 (incf sum-used-n-cells used-n-cells) | |
| 375 (incf sum-used-space used-space) | |
| 376 (incf sum-used-total used-total) | |
| 377 (incf sum-total-n-cells total-n-cells) | |
| 378 (incf sum-total-space total-space) | |
| 379 (incf sum-total-total total-total)) | |
| 380 (setq plhs (cdr plhs))) | |
| 381 (let ((avg-used-eff (floor (if (not (zerop sum-used-total)) | |
| 382 (* (/ (* sum-used-space 1.0) | |
| 383 (* sum-used-total 1.0)) | |
| 384 100.0) | |
| 385 0))) | |
| 386 (avg-total-eff (floor (if (not (zerop sum-total-total)) | |
| 387 (* (/ (* sum-total-space 1.0) | |
| 388 (* sum-total-total 1.0)) | |
| 389 100.0) | |
| 390 0))) | |
| 391 (avg-eff (floor (if (not (zerop sum-total-total)) | |
| 392 (* (/ (* sum-used-space 1.0) | |
| 393 (* sum-total-total 1.0)) | |
| 394 100.0) | |
| 395 0)))) | |
| 396 (princ (format fmt "sum " sum-n-pages sum-used-n-cells | |
| 397 sum-used-space sum-used-total avg-used-eff | |
| 398 sum-total-n-cells sum-total-space | |
| 399 sum-total-total avg-total-eff avg-eff)) | |
| 400 (princ "\n")))) | |
| 2720 | 401 |
| 402 | |
| 4103 | 403 (print-free-plhs (text plhs) |
| 404 (let ((sum-n-pages 0) | |
| 405 (sum-n-sects 0) | |
| 406 (sum-space 0) | |
| 407 (sum-total 0) | |
| 408 (fmt "%6s%10s |%7s%10s\n")) | |
| 409 (princ (format "%s\n" text)) | |
| 410 (princ (format fmt "#pages" "space" "#sects" "total")) | |
| 411 (princ (make-string 35 ?-)) | |
| 412 (princ "\n") | |
| 413 (while plhs | |
| 414 (let* ((elem (car plhs)) | |
| 415 (n-pages (first elem)) | |
| 416 (n-sects (second elem)) | |
| 417 (space (* n-pages page-size)) | |
| 418 (total (* n-sects space))) | |
| 419 (princ (format fmt n-pages space n-sects total)) | |
| 420 (incf sum-n-pages n-pages) | |
| 421 (incf sum-n-sects n-sects) | |
| 422 (incf sum-space space) | |
| 423 (incf sum-total total)) | |
| 424 (setq plhs (cdr plhs))) | |
| 425 (princ (make-string 35 ?=)) | |
| 426 (princ "\n") | |
| 427 (princ (format fmt sum-n-pages sum-space | |
| 428 sum-n-sects sum-total)) | |
| 429 (princ "\n")))) | |
| 2720 | 430 |
| 4103 | 431 (princ (format "%-12s%10s\n\n" "PAGE_SIZE" page-size)) |
| 2720 | 432 |
| 4103 | 433 (print-used-plhs "USED HEAP" used-plhs) |
| 434 (princ "\n\n") | |
| 2720 | 435 |
| 4103 | 436 (print-free-plhs "FREE HEAP" free-plhs) |
| 437 (princ "\n\n") | |
| 2720 | 438 |
| 4103 | 439 (let ((fmt "%-30s%10s\n")) |
| 440 (princ (format fmt "heap sections" "")) | |
| 441 (princ (make-string 40 ?-)) | |
| 442 (princ "\n") | |
| 443 (princ (format fmt "number of heap sects" | |
| 444 (first heap-sects))) | |
| 445 (princ (format fmt "used size" (second heap-sects))) | |
| 446 (princ (make-string 40 ?-)) | |
| 447 (princ "\n") | |
| 448 (princ (format fmt "real size" (third heap-sects))) | |
| 449 (princ (format fmt "global allocator structs" globals)) | |
| 450 (princ (make-string 40 ?-)) | |
| 451 (princ "\n") | |
| 452 (princ (format fmt "real size + structs" | |
| 453 (+ (third heap-sects) globals))) | |
| 454 (princ "\n") | |
| 455 (princ (make-string 40 ?=)) | |
| 456 (princ "\n") | |
| 457 (princ (format fmt "grand total" mc-malloced-bytes))) | |
| 2720 | 458 |
| 4103 | 459 (+ mc-malloced-bytes)))) |
| 460 (message "mc-alloc not used in this XEmacs."))) | |
| 3092 | 461 |
| 462 | |
| 463 (defun show-gc-stats () | |
| 464 "Show statistics about garbage collection cycles." | |
| 465 (interactive) | |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5230
diff
changeset
|
466 (if-fboundp 'gc-stats |
| 4103 | 467 (let ((buffer "*garbage collection statistics*") |
| 468 (plist (gc-stats)) | |
| 469 (fmt "%-9s %16s %12s %12s %12s %12s\n")) | |
| 470 (flet ((plist-get-stat (category field) | |
| 471 (let ((stat (plist-get plist | |
| 472 (intern (concat category field))))) | |
| 473 (if stat | |
| 474 (format "%.0f" stat) | |
| 475 "-"))) | |
| 476 (show-stats (category) | |
| 477 (princ (format fmt category | |
| 478 (plist-get-stat category "-total") | |
| 479 (plist-get-stat category "-in-last-gc") | |
| 480 (plist-get-stat category "-in-this-gc") | |
| 481 (plist-get-stat category "-in-last-cycle") | |
| 482 (plist-get-stat category "-in-this-cycle"))))) | |
| 483 (with-output-to-temp-buffer buffer | |
| 484 (save-excursion | |
| 485 (set-buffer buffer) | |
| 486 (princ (format "%s %g\n" "Current phase" | |
| 487 (plist-get plist 'phase))) | |
| 488 (princ (make-string 78 ?-)) | |
| 489 (princ "\n") | |
| 490 (princ (format fmt "stat" "total" "last-gc" "this-gc" | |
|
5230
4c56e7c6a704
Fix a misspelling, diagnose.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5170
diff
changeset
|
491 "last-cycle" "this-cycle")) |
| 4103 | 492 (princ (make-string 78 ?-)) |
| 493 (princ "\n") | |
| 494 (show-stats "n-gc") | |
| 495 (show-stats "n-cycles") | |
| 496 (show-stats "enqueued") | |
| 497 (show-stats "dequeued") | |
| 498 (show-stats "repushed") | |
| 499 (show-stats "enqueued2") | |
| 500 (show-stats "dequeued2") | |
| 501 (show-stats "finalized") | |
| 502 (show-stats "freed") | |
| 503 (plist-get plist 'n-gc-total))))) | |
| 504 (error 'void-function "gc-stats not available."))) |