From: Richard M. Stallman Date: Sat, 16 Jul 2005 17:24:40 +0000 (+0000) Subject: (find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used) X-Git-Tag: emacs-pretest-22.0.90~8097 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b63ecadb4c3910f9dd0388c396b8b24d44eb9ad5;p=emacs.git (find-gc-unsafe-list, find-gc-source-directory, find-gc-subrs-used) (find-gc-noreturn-list, find-gc-source-files): Vars renamed and defvar'd. --- diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el index 1606395c673..91d1f016627 100644 --- a/lisp/emacs-lisp/find-gc.el +++ b/lisp/emacs-lisp/find-gc.el @@ -23,53 +23,79 @@ ;;; Commentary: -;; Produce in unsafe-list the set of all functions that may invoke GC. -;; This expects the Emacs sources to live in emacs-source-directory. +;; 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-subrs-used nil + "List of subrs used so far in GC testing.") + +;;; Functions on this list are safe, even if they appear to be able +;;; to call the target. + +(defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument)) + +;;; This was originally generated directory-files, but there were +;;; too many files there that were not actually compiled. The +;;; list below was created for a HP-UX 7.0 system. + +(defvar find-gc-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")) + + (defun find-gc-unsafe () + "Return a list of unsafe functions--that is, which can call GC. +Also store it in `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 find-gc-unsafe-list + (sort find-gc-unsafe-list + (function (lambda (x y) + (string-lessp (car x) (car y)))))) ) -(setq emacs-source-directory "/usr/gnu/src/dist/src") - - ;;; This does a depth-first search to find all functions that can ;;; ultimately call the function "target". The result is an a-list -;;; 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 ;;; are (one of) the unsafe functions that these functions directly ;;; call. (defun find-unsafe-funcs (target) - (setq unsafe-list (list (list target))) + (setq find-gc-unsafe-list (list (list target))) (trace-unsafe target) ) (defun trace-unsafe (func) - (let ((used (assq func subrs-used))) + (let ((used (assq func find-gc-subrs-used))) (or used - (error "No subrs-used for %s" (car unsafe-list))) + (error "No find-gc-subrs-used for %s" (car find-gc-unsafe-list))) (while (setq used (cdr used)) - (or (assq (car used) unsafe-list) - (memq (car used) noreturn-list) + (or (assq (car used) find-gc-unsafe-list) + (memq (car used) find-gc-noreturn-list) (progn - (setq unsafe-list (cons (cons (car used) func) unsafe-list)) + (push (cons (car used) func) find-gc-unsafe-list) (trace-unsafe (car used)))))) ) -;;; 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 )) - ;;; This produces an a-list of functions in subrs-called. The cdr of ;;; each entry is a list of functions which the function in car calls. @@ -83,12 +109,12 @@ (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)))) + find-gc-source-directory)))) (save-excursion (set-buffer (get-buffer-create "*Trace Call Tree*")) (setq subrs-called nil) (let ((case-fold-search nil) - (files source-files) + (files find-gc-source-files) name entry) (while files (message "Compiling %s..." (car files)) @@ -117,34 +143,17 @@ ) -;;; This was originally generated directory-files, but there were -;;; 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 +;;; This produces an inverted a-list in find-gc-subrs-used. The cdr of each ;;; entry is a list of functions that call the function in car. (defun trace-use-tree () - (setq subrs-used (mapcar 'list (mapcar 'car subrs-called))) + (setq find-gc-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)) + (if (setq found (assq (car p2) find-gc-subrs-used)) (setcdr found (cons (car (car ptr)) (cdr found))))) (setq ptr (cdr ptr)))) )