(defun find-gc-unsafe ()
(trace-call-tree nil)
(trace-use-tree)
(find-unsafe-funcs 'Fgarbage_collect)
(setq unsafe-list (sort unsafe-list
(function (lambda (x y)
(string-lessp (car x) (car y))))))
)
(setq emacs-source-directory "/usr/gnu/src/dist/src")
(defun find-unsafe-funcs (target)
(setq unsafe-list (list (list target)))
(trace-unsafe target)
)
(defun trace-unsafe (func)
(let ((used (assq func subrs-used)))
(or used
(error "No subrs-used for %s" (car unsafe-list)))
(while (setq used (cdr used))
(or (assq (car used) unsafe-list)
(memq (car used) noreturn-list)
(progn
(setq unsafe-list (cons (cons (car used) func) unsafe-list))
(trace-unsafe (car used))))))
)
(setq noreturn-list '( Fsignal Fthrow wrong_type_argument ))
(defun trace-call-tree (&optional already-setup)
(message "Setting up directories...")
(or already-setup
(progn
(call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc")
(call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc")
(call-process "csh" nil nil nil "-c"
(format "ln -s %s/*.[ch] /tmp/esrc"
emacs-source-directory))))
(save-excursion
(set-buffer (get-buffer-create "*Trace Call Tree*"))
(setq subrs-called nil)
(let ((case-fold-search nil)
(files source-files)
name entry)
(while files
(message "Compiling %s..." (car files))
(call-process "csh" nil nil nil "-c"
(format "gcc -dr -c /tmp/esrc/%s -o /dev/null"
(car files)))
(erase-buffer)
(insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl"))
(while (re-search-forward ";; Function \\|(call_insn " nil t)
(if (= (char-after (- (point) 3)) ?o)
(progn
(looking-at "[a-zA-Z0-9_]+")
(setq name (intern (buffer-substring (match-beginning 0)
(match-end 0))))
(message "%s : %s" (car files) name)
(setq entry (list name)
subrs-called (cons entry subrs-called)))
(if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
(progn
(setq name (intern (buffer-substring (match-beginning 1)
(match-end 1))))
(or (memq name (cdr entry))
(setcdr entry (cons name (cdr entry))))))))
(delete-file (concat "/tmp/esrc/" (car files) ".rtl"))
(setq files (cdr files)))))
)
(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" "mocklisp.c"
"bytecode.c" "process.c" "callproc.c" "doprnt.c"
"x11term.c" "x11fns.c"))
(defun trace-use-tree ()
(setq subrs-used (mapcar 'list (mapcar 'car subrs-called)))
(let ((ptr subrs-called)
p2 found)
(while ptr
(setq p2 (car ptr))
(while (setq p2 (cdr p2))
(if (setq found (assq (car p2) subrs-used))
(setcdr found (cons (car (car ptr)) (cdr found)))))
(setq ptr (cdr ptr))))
)
(provide 'find-gc)