23 |
|
|
24 |
;;; Commentary: |
;;; Commentary: |
25 |
|
|
26 |
;; Produce in unsafe-list the set of all functions that may invoke GC. |
;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC. |
27 |
;; This expects the Emacs sources to live in emacs-source-directory. |
;; This expects the Emacs sources to live in find-gc-source-directory. |
28 |
;; It creates a temporary working directory /tmp/esrc. |
;; It creates a temporary working directory /tmp/esrc. |
29 |
|
|
30 |
;;; Code: |
;;; Code: |
31 |
|
|
32 |
|
(defvar find-gc-unsafe-list nil |
33 |
|
"The list of unsafe functions is placed here by `find-gc-unsafe'.") |
34 |
|
|
35 |
|
(defvar find-gc-source-directory) |
36 |
|
|
37 |
|
(defvar find-gc-subrs-used nil |
38 |
|
"List of subrs used so far in GC testing.") |
39 |
|
|
40 |
|
;;; Functions on this list are safe, even if they appear to be able |
41 |
|
;;; to call the target. |
42 |
|
|
43 |
|
(defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument)) |
44 |
|
|
45 |
|
;;; This was originally generated directory-files, but there were |
46 |
|
;;; too many files there that were not actually compiled. The |
47 |
|
;;; list below was created for a HP-UX 7.0 system. |
48 |
|
|
49 |
|
(defvar find-gc-source-files |
50 |
|
'("dispnew.c" "scroll.c" "xdisp.c" "window.c" |
51 |
|
"term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" |
52 |
|
"keymap.c" "sysdep.c" "buffer.c" "filelock.c" |
53 |
|
"insdel.c" "marker.c" "minibuf.c" "fileio.c" |
54 |
|
"dired.c" "filemode.c" "cmds.c" "casefiddle.c" |
55 |
|
"indent.c" "search.c" "regex.c" "undo.c" |
56 |
|
"alloc.c" "data.c" "doc.c" "editfns.c" |
57 |
|
"callint.c" "eval.c" "fns.c" "print.c" "lread.c" |
58 |
|
"abbrev.c" "syntax.c" "unexec.c" |
59 |
|
"bytecode.c" "process.c" "callproc.c" "doprnt.c" |
60 |
|
"x11term.c" "x11fns.c")) |
61 |
|
|
62 |
|
|
63 |
(defun find-gc-unsafe () |
(defun find-gc-unsafe () |
64 |
|
"Return a list of unsafe functions--that is, which can call GC. |
65 |
|
Also store it in `find-gc-unsafe'." |
66 |
(trace-call-tree nil) |
(trace-call-tree nil) |
67 |
(trace-use-tree) |
(trace-use-tree) |
68 |
(find-unsafe-funcs 'Fgarbage_collect) |
(find-unsafe-funcs 'Fgarbage_collect) |
69 |
(setq unsafe-list (sort unsafe-list |
(setq find-gc-unsafe-list |
70 |
(function (lambda (x y) |
(sort find-gc-unsafe-list |
71 |
(string-lessp (car x) (car y)))))) |
(function (lambda (x y) |
72 |
|
(string-lessp (car x) (car y)))))) |
73 |
) |
) |
74 |
|
|
|
(setq emacs-source-directory "/usr/gnu/src/dist/src") |
|
|
|
|
|
|
|
75 |
;;; This does a depth-first search to find all functions that can |
;;; This does a depth-first search to find all functions that can |
76 |
;;; ultimately call the function "target". The result is an a-list |
;;; ultimately call the function "target". The result is an a-list |
77 |
;;; in unsafe-list; the cars are the unsafe functions, and the cdrs |
;;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs |
78 |
;;; are (one of) the unsafe functions that these functions directly |
;;; are (one of) the unsafe functions that these functions directly |
79 |
;;; call. |
;;; call. |
80 |
|
|
81 |
(defun find-unsafe-funcs (target) |
(defun find-unsafe-funcs (target) |
82 |
(setq unsafe-list (list (list target))) |
(setq find-gc-unsafe-list (list (list target))) |
83 |
(trace-unsafe target) |
(trace-unsafe target) |
84 |
) |
) |
85 |
|
|
86 |
(defun trace-unsafe (func) |
(defun trace-unsafe (func) |
87 |
(let ((used (assq func subrs-used))) |
(let ((used (assq func find-gc-subrs-used))) |
88 |
(or used |
(or used |
89 |
(error "No subrs-used for %s" (car unsafe-list))) |
(error "No find-gc-subrs-used for %s" (car find-gc-unsafe-list))) |
90 |
(while (setq used (cdr used)) |
(while (setq used (cdr used)) |
91 |
(or (assq (car used) unsafe-list) |
(or (assq (car used) find-gc-unsafe-list) |
92 |
(memq (car used) noreturn-list) |
(memq (car used) find-gc-noreturn-list) |
93 |
(progn |
(progn |
94 |
(setq unsafe-list (cons (cons (car used) func) unsafe-list)) |
(push (cons (car used) func) find-gc-unsafe-list) |
95 |
(trace-unsafe (car used)))))) |
(trace-unsafe (car used)))))) |
96 |
) |
) |
97 |
|
|
98 |
|
|
|
;;; Functions on this list are safe, even if they appear to be able |
|
|
;;; to call the target. |
|
|
|
|
|
(setq noreturn-list '( Fsignal Fthrow wrong_type_argument )) |
|
|
|
|
99 |
|
|
100 |
;;; This produces an a-list of functions in subrs-called. The cdr of |
;;; This produces an a-list of functions in subrs-called. The cdr of |
101 |
;;; each entry is a list of functions which the function in car calls. |
;;; each entry is a list of functions which the function in car calls. |
109 |
(call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc") |
(call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc") |
110 |
(call-process "csh" nil nil nil "-c" |
(call-process "csh" nil nil nil "-c" |
111 |
(format "ln -s %s/*.[ch] /tmp/esrc" |
(format "ln -s %s/*.[ch] /tmp/esrc" |
112 |
emacs-source-directory)))) |
find-gc-source-directory)))) |
113 |
(save-excursion |
(save-excursion |
114 |
(set-buffer (get-buffer-create "*Trace Call Tree*")) |
(set-buffer (get-buffer-create "*Trace Call Tree*")) |
115 |
(setq subrs-called nil) |
(setq subrs-called nil) |
116 |
(let ((case-fold-search nil) |
(let ((case-fold-search nil) |
117 |
(files source-files) |
(files find-gc-source-files) |
118 |
name entry) |
name entry) |
119 |
(while files |
(while files |
120 |
(message "Compiling %s..." (car files)) |
(message "Compiling %s..." (car files)) |
143 |
) |
) |
144 |
|
|
145 |
|
|
146 |
;;; This was originally generated directory-files, but there were |
;;; This produces an inverted a-list in find-gc-subrs-used. The cdr of each |
|
;;; too many files there that were not actually compiled. The |
|
|
;;; list below was created for a HP-UX 7.0 system. |
|
|
|
|
|
(setq source-files '("dispnew.c" "scroll.c" "xdisp.c" "window.c" |
|
|
"term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" |
|
|
"keymap.c" "sysdep.c" "buffer.c" "filelock.c" |
|
|
"insdel.c" "marker.c" "minibuf.c" "fileio.c" |
|
|
"dired.c" "filemode.c" "cmds.c" "casefiddle.c" |
|
|
"indent.c" "search.c" "regex.c" "undo.c" |
|
|
"alloc.c" "data.c" "doc.c" "editfns.c" |
|
|
"callint.c" "eval.c" "fns.c" "print.c" "lread.c" |
|
|
"abbrev.c" "syntax.c" "unexec.c" |
|
|
"bytecode.c" "process.c" "callproc.c" "doprnt.c" |
|
|
"x11term.c" "x11fns.c")) |
|
|
|
|
|
|
|
|
;;; This produces an inverted a-list in subrs-used. The cdr of each |
|
147 |
;;; entry is a list of functions that call the function in car. |
;;; entry is a list of functions that call the function in car. |
148 |
|
|
149 |
(defun trace-use-tree () |
(defun trace-use-tree () |
150 |
(setq subrs-used (mapcar 'list (mapcar 'car subrs-called))) |
(setq find-gc-subrs-used (mapcar 'list (mapcar 'car subrs-called))) |
151 |
(let ((ptr subrs-called) |
(let ((ptr subrs-called) |
152 |
p2 found) |
p2 found) |
153 |
(while ptr |
(while ptr |
154 |
(setq p2 (car ptr)) |
(setq p2 (car ptr)) |
155 |
(while (setq p2 (cdr p2)) |
(while (setq p2 (cdr p2)) |
156 |
(if (setq found (assq (car p2) subrs-used)) |
(if (setq found (assq (car p2) find-gc-subrs-used)) |
157 |
(setcdr found (cons (car (car ptr)) (cdr found))))) |
(setcdr found (cons (car (car ptr)) (cdr found))))) |
158 |
(setq ptr (cdr ptr)))) |
(setq ptr (cdr ptr)))) |
159 |
) |
) |