Mercurial > emacs
annotate lisp/emacs-lisp/find-gc.el @ 107168:282ddc0ca465
* simple.el (save-interprogram-paste-before-kill): Doc fix.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 16 Feb 2010 09:40:45 -0500 |
parents | 1d1d5d9bd884 |
children | 8e2c7c31861b 376148b31b5e |
rev | line source |
---|---|
39027 | 1 ;;; find-gc.el --- detect functions that call the garbage collector |
2 | |
74466 | 3 ;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, |
106815 | 4 ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
39027 | 5 |
6 ;; Maintainer: FSF | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
39027 | 11 ;; it under the terms of the GNU General Public License as published by |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; (at your option) any later version. |
39027 | 14 |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
39027 | 22 |
23 ;;; Commentary: | |
24 | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
25 ;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC. |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
26 ;; This expects the Emacs sources to live in find-gc-source-directory. |
39027 | 27 ;; It creates a temporary working directory /tmp/esrc. |
28 | |
29 ;;; Code: | |
30 | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
31 (defvar find-gc-unsafe-list nil |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
32 "The list of unsafe functions is placed here by `find-gc-unsafe'.") |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
33 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
34 (defvar find-gc-source-directory) |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
35 |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
36 (defvar find-gc-subrs-callers nil |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
37 "Alist of users of subrs, from GC testing. |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
38 Each entry has the form (FUNCTION . FUNCTIONS-THAT-CALL-IT).") |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
39 |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
40 (defvar find-gc-subrs-called nil |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
41 "Alist of subrs called, in GC testing. |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
42 Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
43 |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
44 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
45 ;;; Functions on this list are safe, even if they appear to be able |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
46 ;;; to call the target. |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
47 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
48 (defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument)) |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
49 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
50 ;;; This was originally generated directory-files, but there were |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
51 ;;; too many files there that were not actually compiled. The |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
52 ;;; list below was created for a HP-UX 7.0 system. |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
53 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
54 (defvar find-gc-source-files |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
55 '("dispnew.c" "scroll.c" "xdisp.c" "window.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
56 "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
57 "keymap.c" "sysdep.c" "buffer.c" "filelock.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
58 "insdel.c" "marker.c" "minibuf.c" "fileio.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
59 "dired.c" "filemode.c" "cmds.c" "casefiddle.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
60 "indent.c" "search.c" "regex.c" "undo.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
61 "alloc.c" "data.c" "doc.c" "editfns.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
62 "callint.c" "eval.c" "fns.c" "print.c" "lread.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
63 "abbrev.c" "syntax.c" "unexec.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
64 "bytecode.c" "process.c" "callproc.c" "doprnt.c" |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
65 "x11term.c" "x11fns.c")) |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
66 |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
67 |
39027 | 68 (defun find-gc-unsafe () |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
69 "Return a list of unsafe functions--that is, which can call GC. |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
70 Also store it in `find-gc-unsafe'." |
39027 | 71 (trace-call-tree nil) |
72 (trace-use-tree) | |
73 (find-unsafe-funcs 'Fgarbage_collect) | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
74 (setq find-gc-unsafe-list |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
75 (sort find-gc-unsafe-list |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
76 (function (lambda (x y) |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
77 (string-lessp (car x) (car y)))))) |
39027 | 78 ) |
79 | |
80 ;;; This does a depth-first search to find all functions that can | |
81 ;;; ultimately call the function "target". The result is an a-list | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
82 ;;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs |
39027 | 83 ;;; are (one of) the unsafe functions that these functions directly |
84 ;;; call. | |
85 | |
86 (defun find-unsafe-funcs (target) | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
87 (setq find-gc-unsafe-list (list (list target))) |
39027 | 88 (trace-unsafe target) |
89 ) | |
90 | |
91 (defun trace-unsafe (func) | |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
92 (let ((used (assq func find-gc-subrs-callers))) |
39027 | 93 (or used |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
94 (error "No find-gc-subrs-callers for %s" (car find-gc-unsafe-list))) |
39027 | 95 (while (setq used (cdr used)) |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
96 (or (assq (car used) find-gc-unsafe-list) |
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
97 (memq (car used) find-gc-noreturn-list) |
39027 | 98 (progn |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
99 (push (cons (car used) func) find-gc-unsafe-list) |
39027 | 100 (trace-unsafe (car used)))))) |
101 ) | |
102 | |
103 | |
104 | |
105 | |
106 (defun trace-call-tree (&optional already-setup) | |
107 (message "Setting up directories...") | |
108 (or already-setup | |
109 (progn | |
110 ;; Gee, wouldn't a built-in "system" function be handy here. | |
111 (call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc") | |
112 (call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc") | |
113 (call-process "csh" nil nil nil "-c" | |
114 (format "ln -s %s/*.[ch] /tmp/esrc" | |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
115 find-gc-source-directory)))) |
105813
df4934f25eef
* textmodes/two-column.el (2C-split):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
116 (with-current-buffer (get-buffer-create "*Trace Call Tree*") |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
117 (setq find-gc-subrs-called nil) |
39027 | 118 (let ((case-fold-search nil) |
64380
ce8784010c3c
(find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used)
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
119 (files find-gc-source-files) |
39027 | 120 name entry) |
121 (while files | |
122 (message "Compiling %s..." (car files)) | |
123 (call-process "csh" nil nil nil "-c" | |
124 (format "gcc -dr -c /tmp/esrc/%s -o /dev/null" | |
125 (car files))) | |
126 (erase-buffer) | |
127 (insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl")) | |
128 (while (re-search-forward ";; Function \\|(call_insn " nil t) | |
129 (if (= (char-after (- (point) 3)) ?o) | |
130 (progn | |
131 (looking-at "[a-zA-Z0-9_]+") | |
132 (setq name (intern (buffer-substring (match-beginning 0) | |
133 (match-end 0)))) | |
134 (message "%s : %s" (car files) name) | |
135 (setq entry (list name) | |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
136 find-gc-subrs-called (cons entry find-gc-subrs-called))) |
39027 | 137 (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"") |
138 (progn | |
139 (setq name (intern (buffer-substring (match-beginning 1) | |
140 (match-end 1)))) | |
141 (or (memq name (cdr entry)) | |
142 (setcdr entry (cons name (cdr entry)))))))) | |
143 (delete-file (concat "/tmp/esrc/" (car files) ".rtl")) | |
144 (setq files (cdr files))))) | |
145 ) | |
146 | |
147 | |
148 (defun trace-use-tree () | |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
149 (setq find-gc-subrs-callers (mapcar 'list (mapcar 'car find-gc-subrs-called))) |
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
150 (let ((ptr find-gc-subrs-called) |
39027 | 151 p2 found) |
152 (while ptr | |
153 (setq p2 (car ptr)) | |
154 (while (setq p2 (cdr p2)) | |
64403
db69241fec2b
(find-gc-subrs-callers): Renamed from find-gc-subrs-used.
Richard M. Stallman <rms@gnu.org>
parents:
64380
diff
changeset
|
155 (if (setq found (assq (car p2) find-gc-subrs-callers)) |
39027 | 156 (setcdr found (cons (car (car ptr)) (cdr found))))) |
157 (setq ptr (cdr ptr)))) | |
158 ) | |
159 | |
160 (provide 'find-gc) | |
161 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79704
diff
changeset
|
162 ;; arch-tag: 4a26a538-a008-40d9-a1ef-23bb6dbecef4 |
39027 | 163 ;;; find-gc.el ends here |