4 ;;; Produce in unsafe-list the set of all functions that may invoke GC.
5 ;;; This expects the Emacs sources to live in emacs-source-directory.
6 ;;; It creates a temporary working directory /tmp/esrc.
8 (defun find-gc-unsafe ()
11 (find-unsafe-funcs 'Fgarbage_collect
)
12 (setq unsafe-list
(sort unsafe-list
13 (function (lambda (x y
)
14 (string-lessp (car x
) (car y
))))))
17 (setq emacs-source-directory
"/usr/gnu/src/dist/src")
20 ;;; This does a depth-first search to find all functions that can
21 ;;; ultimately call the function "target". The result is an a-list
22 ;;; in unsafe-list; the cars are the unsafe functions, and the cdrs
23 ;;; are (one of) the unsafe functions that these functions directly
26 (defun find-unsafe-funcs (target)
27 (setq unsafe-list
(list (list target
)))
31 (defun trace-unsafe (func)
32 (let ((used (assq func subrs-used
)))
34 (error "No subrs-used for %s" (car unsafe-list
)))
35 (while (setq used
(cdr used
))
36 (or (assq (car used
) unsafe-list
)
37 (memq (car used
) noreturn-list
)
39 (setq unsafe-list
(cons (cons (car used
) func
) unsafe-list
))
40 (trace-unsafe (car used
))))))
44 ;;; Functions on this list are safe, even if they appear to be able
45 ;;; to call the target.
47 (setq noreturn-list
'( Fsignal Fthrow wrong_type_argument
))
50 ;;; This produces an a-list of functions in subrs-called. The cdr of
51 ;;; each entry is a list of functions which the function in car calls.
53 (defun trace-call-tree (&optional already-setup
)
54 (message "Setting up directories...")
57 ;; Gee, wouldn't a built-in "system" function be handy here.
58 (call-process "csh" nil nil nil
"-c" "rm -rf /tmp/esrc")
59 (call-process "csh" nil nil nil
"-c" "mkdir /tmp/esrc")
60 (call-process "csh" nil nil nil
"-c"
61 (format "ln -s %s/*.[ch] /tmp/esrc"
62 emacs-source-directory
))))
64 (set-buffer (get-buffer-create "*Trace Call Tree*"))
65 (setq subrs-called nil
)
66 (let ((case-fold-search nil
)
70 (message "Compiling %s..." (car files
))
71 (call-process "csh" nil nil nil
"-c"
72 (format "gcc -dr -c /tmp/esrc/%s -o /dev/null"
75 (insert-file-contents (concat "/tmp/esrc/" (car files
) ".rtl"))
76 (while (re-search-forward ";; Function \\|(call_insn " nil t
)
77 (if (= (char-after (- (point) 3)) ?o
)
79 (looking-at "[a-zA-Z0-9_]+")
80 (setq name
(intern (buffer-substring (match-beginning 0)
82 (message "%s : %s" (car files
) name
)
83 (setq entry
(list name
)
84 subrs-called
(cons entry subrs-called
)))
85 (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
87 (setq name
(intern (buffer-substring (match-beginning 1)
89 (or (memq name
(cdr entry
))
90 (setcdr entry
(cons name
(cdr entry
))))))))
91 (delete-file (concat "/tmp/esrc/" (car files
) ".rtl"))
92 (setq files
(cdr files
)))))
96 ;;; This was originally generated directory-files, but there were
97 ;;; too many files there that were not actually compiled. The
98 ;;; list below was created for a HP-UX 7.0 system.
100 (setq source-files
'("dispnew.c" "scroll.c" "xdisp.c" "window.c"
101 "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c"
102 "keymap.c" "sysdep.c" "buffer.c" "filelock.c"
103 "insdel.c" "marker.c" "minibuf.c" "fileio.c"
104 "dired.c" "filemode.c" "cmds.c" "casefiddle.c"
105 "indent.c" "search.c" "regex.c" "undo.c"
106 "alloc.c" "data.c" "doc.c" "editfns.c"
107 "callint.c" "eval.c" "fns.c" "print.c" "lread.c"
108 "abbrev.c" "syntax.c" "unexec.c" "mocklisp.c"
109 "bytecode.c" "process.c" "callproc.c" "doprnt.c"
110 "x11term.c" "x11fns.c"))
113 ;;; This produces an inverted a-list in subrs-used. The cdr of each
114 ;;; entry is a list of functions that call the function in car.
116 (defun trace-use-tree ()
117 (setq subrs-used
(mapcar 'list
(mapcar 'car subrs-called
)))
118 (let ((ptr subrs-called
)
122 (while (setq p2
(cdr p2
))
123 (if (setq found
(assq (car p2
) subrs-used
))
124 (setcdr found
(cons (car (car ptr
)) (cdr found
)))))
125 (setq ptr
(cdr ptr
))))