Mercurial > emacs
annotate lisp/find-gc.el @ 2921:37503f466755
Some time-handling patches from Paul Eggert:
* editfns.c (Fcurrent_time_zone): Take an optional argument specifying
what (absolute) time should be used to determine the current time zone.
Yield just offset and name of time zone, including DST correction.
Yield time zone offset in seconds, not minutes.
(lisp_time_argument, difftm): New functions.
(Fcurrent_time_string): Use lisp_time_argument.
* systime.h (EMACS_CURRENT_TIME_ZONE, EMACS_GET_TZ_OFFSET,
EMACS_GET_TZ_NAMES): Remove.
* config.h.in: Add HAVE_TM_ZONE.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Thu, 20 May 1993 06:29:45 +0000 |
parents | 6314334d7c2b |
children | 83f275dcd93a |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
1 ;;; find-gc.el --- detect functions that call the garbage collector |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
5 ;; Maintainer: FSF |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
6 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
7 ;; This file is part of GNU Emacs. |
123 | 8 |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
10 ;; it under the terms of the GNU General Public License as published by |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
11 ;; the Free Software Foundation; either version 2, or (at your option) |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
12 ;; any later version. |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
13 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
14 ;; GNU Emacs is distributed in the hope that it will be useful, |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
17 ;; GNU General Public License for more details. |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
18 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
19 ;; You should have received a copy of the GNU General Public License |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
123 | 22 |
2230
6314334d7c2b
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
23 ;;; Commentary: |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
24 |
123 | 25 ;;; Produce in unsafe-list the set of all functions that may invoke GC. |
26 ;;; This expects the Emacs sources to live in emacs-source-directory. | |
27 ;;; It creates a temporary working directory /tmp/esrc. | |
28 | |
2230
6314334d7c2b
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
29 ;;; Code: |
6314334d7c2b
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
30 |
123 | 31 (defun find-gc-unsafe () |
32 (trace-call-tree nil) | |
33 (trace-use-tree) | |
34 (find-unsafe-funcs 'Fgarbage_collect) | |
35 (setq unsafe-list (sort unsafe-list | |
36 (function (lambda (x y) | |
37 (string-lessp (car x) (car y)))))) | |
38 ) | |
39 | |
40 (setq emacs-source-directory "/usr/gnu/src/dist/src") | |
41 | |
42 | |
43 ;;; This does a depth-first search to find all functions that can | |
44 ;;; ultimately call the function "target". The result is an a-list | |
45 ;;; in unsafe-list; the cars are the unsafe functions, and the cdrs | |
46 ;;; are (one of) the unsafe functions that these functions directly | |
47 ;;; call. | |
48 | |
49 (defun find-unsafe-funcs (target) | |
50 (setq unsafe-list (list (list target))) | |
51 (trace-unsafe target) | |
52 ) | |
53 | |
54 (defun trace-unsafe (func) | |
55 (let ((used (assq func subrs-used))) | |
56 (or used | |
57 (error "No subrs-used for %s" (car unsafe-list))) | |
58 (while (setq used (cdr used)) | |
59 (or (assq (car used) unsafe-list) | |
60 (memq (car used) noreturn-list) | |
61 (progn | |
62 (setq unsafe-list (cons (cons (car used) func) unsafe-list)) | |
63 (trace-unsafe (car used)))))) | |
64 ) | |
65 | |
66 | |
67 ;;; Functions on this list are safe, even if they appear to be able | |
68 ;;; to call the target. | |
69 | |
70 (setq noreturn-list '( Fsignal Fthrow wrong_type_argument )) | |
71 | |
72 | |
73 ;;; This produces an a-list of functions in subrs-called. The cdr of | |
74 ;;; each entry is a list of functions which the function in car calls. | |
75 | |
76 (defun trace-call-tree (&optional already-setup) | |
77 (message "Setting up directories...") | |
78 (or already-setup | |
79 (progn | |
80 ;; Gee, wouldn't a built-in "system" function be handy here. | |
81 (call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc") | |
82 (call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc") | |
83 (call-process "csh" nil nil nil "-c" | |
84 (format "ln -s %s/*.[ch] /tmp/esrc" | |
85 emacs-source-directory)))) | |
86 (save-excursion | |
87 (set-buffer (get-buffer-create "*Trace Call Tree*")) | |
88 (setq subrs-called nil) | |
89 (let ((case-fold-search nil) | |
90 (files source-files) | |
91 name entry) | |
92 (while files | |
93 (message "Compiling %s..." (car files)) | |
94 (call-process "csh" nil nil nil "-c" | |
95 (format "gcc -dr -c /tmp/esrc/%s -o /dev/null" | |
96 (car files))) | |
97 (erase-buffer) | |
98 (insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl")) | |
99 (while (re-search-forward ";; Function \\|(call_insn " nil t) | |
100 (if (= (char-after (- (point) 3)) ?o) | |
101 (progn | |
102 (looking-at "[a-zA-Z0-9_]+") | |
103 (setq name (intern (buffer-substring (match-beginning 0) | |
104 (match-end 0)))) | |
105 (message "%s : %s" (car files) name) | |
106 (setq entry (list name) | |
107 subrs-called (cons entry subrs-called))) | |
108 (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"") | |
109 (progn | |
110 (setq name (intern (buffer-substring (match-beginning 1) | |
111 (match-end 1)))) | |
112 (or (memq name (cdr entry)) | |
113 (setcdr entry (cons name (cdr entry)))))))) | |
114 (delete-file (concat "/tmp/esrc/" (car files) ".rtl")) | |
115 (setq files (cdr files))))) | |
116 ) | |
117 | |
118 | |
119 ;;; This was originally generated directory-files, but there were | |
120 ;;; too many files there that were not actually compiled. The | |
121 ;;; list below was created for a HP-UX 7.0 system. | |
122 | |
123 (setq source-files '("dispnew.c" "scroll.c" "xdisp.c" "window.c" | |
124 "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" | |
125 "keymap.c" "sysdep.c" "buffer.c" "filelock.c" | |
126 "insdel.c" "marker.c" "minibuf.c" "fileio.c" | |
127 "dired.c" "filemode.c" "cmds.c" "casefiddle.c" | |
128 "indent.c" "search.c" "regex.c" "undo.c" | |
129 "alloc.c" "data.c" "doc.c" "editfns.c" | |
130 "callint.c" "eval.c" "fns.c" "print.c" "lread.c" | |
131 "abbrev.c" "syntax.c" "unexec.c" "mocklisp.c" | |
132 "bytecode.c" "process.c" "callproc.c" "doprnt.c" | |
133 "x11term.c" "x11fns.c")) | |
134 | |
135 | |
136 ;;; This produces an inverted a-list in subrs-used. The cdr of each | |
137 ;;; entry is a list of functions that call the function in car. | |
138 | |
139 (defun trace-use-tree () | |
140 (setq subrs-used (mapcar 'list (mapcar 'car subrs-called))) | |
141 (let ((ptr subrs-called) | |
142 p2 found) | |
143 (while ptr | |
144 (setq p2 (car ptr)) | |
145 (while (setq p2 (cdr p2)) | |
146 (if (setq found (assq (car p2) subrs-used)) | |
147 (setcdr found (cons (car (car ptr)) (cdr found))))) | |
148 (setq ptr (cdr ptr)))) | |
149 ) | |
150 | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
123
diff
changeset
|
151 ;;; find-gc.el ends here |