From 0c4decaeb1b14dbea8bf18b5ab2e52ca9c9c9d4c Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 5 May 2014 20:53:31 -0700 Subject: [PATCH] find-gc.el misc fixes The whole file looks obsolete and/or broken. * lisp/emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value. (find-gc-source-files): Update some names. (trace-call-tree): Simplify and update. Avoid predictable temp-file names. --- lisp/ChangeLog | 7 ++++ lisp/emacs-lisp/find-gc.el | 80 +++++++++++++++++--------------------- 2 files changed, 43 insertions(+), 44 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6aabf022b7..713d34dda8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2014-05-06 Glenn Morris + + * emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value. + (find-gc-source-files): Update some names. + (trace-call-tree): Simplify and update. + Avoid predictable temp-file names. (http://bugs.debian.org/747100) + 2014-05-05 Stefan Monnier * minibuffer.el (completion--try-word-completion): Revert fix for diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el index ff9062150d..3608e7a0b7 100644 --- a/lisp/emacs-lisp/find-gc.el +++ b/lisp/emacs-lisp/find-gc.el @@ -23,14 +23,15 @@ ;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC. ;; This expects the Emacs sources to live in find-gc-source-directory. -;; It creates a temporary working directory /tmp/esrc. ;;; Code: (defvar find-gc-unsafe-list nil "The list of unsafe functions is placed here by `find-gc-unsafe'.") -(defvar find-gc-source-directory) +(defvar find-gc-source-directory + (file-name-as-directory (expand-file-name "src" source-directory)) + "Directory containing Emacs C sources.") (defvar find-gc-subrs-callers nil "Alist of users of subrs, from GC testing. @@ -59,14 +60,14 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") "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" "unexcoff.c" + "syntax.c" "unexcoff.c" "bytecode.c" "process.c" "callproc.c" "doprnt.c" - "x11term.c" "x11fns.c")) + "xterm.c" "xfns.c")) (defun find-gc-unsafe () "Return a list of unsafe functions--that is, which can call GC. -Also store it in `find-gc-unsafe'." +Also store it in `find-gc-unsafe-list'." (trace-call-tree nil) (trace-use-tree) (find-unsafe-funcs 'Fgarbage_collect) @@ -102,47 +103,38 @@ Also store it in `find-gc-unsafe'." -(defun trace-call-tree (&optional already-setup) +(defun trace-call-tree (&optional ignored) (message "Setting up directories...") - (or already-setup - (progn - ;; Gee, wouldn't a built-in "system" function be handy here. - (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" - find-gc-source-directory)))) - (with-current-buffer (get-buffer-create "*Trace Call Tree*") - (setq find-gc-subrs-called nil) - (let ((case-fold-search nil) - (files find-gc-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) - find-gc-subrs-called (cons entry find-gc-subrs-called))) - (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"") + (setq find-gc-subrs-called nil) + (let ((case-fold-search nil) + (default-directory find-gc-source-directory) + (files find-gc-source-files) + name entry rtlfile) + (dolist (file files) + (message "Compiling %s..." file) + (call-process "gcc" nil nil nil "-I" "." "-I" "../lib" + "-fdump-rtl-expand" "-o" null-device "-c" file) + (setq rtlfile + (file-expand-wildcards (format "%s.*.expand" file) t)) + (if (/= 1 (length rtlfile)) + (message "Error compiling `%s'?" file) + (with-temp-buffer + (insert-file-contents (setq rtlfile (car rtlfile))) + (delete-file rtlfile) + (while (re-search-forward ";; Function \\|(call_insn " nil t) + (if (= (char-after (- (point) 3)) ?o) (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))))) -) - + (looking-at "[a-zA-Z0-9_]+") + (setq name (intern (match-string 0))) + (message "%s : %s" (car files) name) + (setq entry (list name) + find-gc-subrs-called + (cons entry find-gc-subrs-called))) + (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"") + (progn + (setq name (intern (match-string 1))) + (or (memq name (cdr entry)) + (setcdr entry (cons name (cdr entry))))))))))))) (defun trace-use-tree () (setq find-gc-subrs-callers (mapcar 'list (mapcar 'car find-gc-subrs-called))) -- 2.20.1