Mercurial > emacs
comparison lisp/emacs-lisp/bytecomp.el @ 784:6d993c174c62
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 15 Jul 1992 20:26:37 +0000 |
parents | 745b7fc3a3d3 |
children | 5bbabfcef929 |
comparison
equal
deleted
inserted
replaced
783:59dc833c4e0c | 784:6d993c174c62 |
---|---|
1 ;;; -*- Mode: Emacs-Lisp -*- | 1 ;;; -*- Mode: Emacs-Lisp -*- |
2 ;;; Compilation of Lisp code into byte code. | 2 ;;; Compilation of Lisp code into byte code. |
3 ;;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. | 3 ;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
4 | 4 |
5 ;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>. | 5 ;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>. |
6 | 6 ;; Subsequently modified by RMS. |
7 (defconst byte-compile-version "2.04; 5-feb-92.") | 7 |
8 (defconst byte-compile-version "FSF 2.1") | |
8 | 9 |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 | 11 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
12 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | 23 ;; along with GNU Emacs; see the file COPYING. If not, write to |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
24 | 25 |
25 ;;; ======================================================================== | 26 ;;; ======================================================================== |
26 ;;; Entry points: | 27 ;;; Entry points: |
27 ;;; byte-recompile-directory, byte-compile-file, | 28 ;;; byte-recompile-directory, byte-compile-file, batch-byte-compile, |
28 ;;; byte-compile-and-load-file byte-compile-buffer, batch-byte-compile, | 29 ;;; byte-compile, compile-defun |
29 ;;; byte-compile, byte-compile-sexp, elisp-compile-defun, | 30 ;;; display-call-tree |
30 ;;; byte-compile-report-call-tree | 31 ;;; (byte-compile-buffer and byte-compile-and-load-file were turned off |
31 | 32 ;;; because they are not terribly useful and get in the way of completion.) |
32 ;;; This version of the elisp byte compiler has the following improvements: | 33 |
34 ;;; This version of the byte compiler has the following improvements: | |
33 ;;; + optimization of compiled code: | 35 ;;; + optimization of compiled code: |
34 ;;; - removal of unreachable code; | 36 ;;; - removal of unreachable code; |
35 ;;; - removal of calls to side-effectless functions whose return-value | 37 ;;; - removal of calls to side-effectless functions whose return-value |
36 ;;; is unused; | 38 ;;; is unused; |
37 ;;; - compile-time evaluation of safe constant forms, such as (consp nil) | 39 ;;; - compile-time evaluation of safe constant forms, such as (consp nil) |
81 ;;; 'redefine (function cell redefined from | 83 ;;; 'redefine (function cell redefined from |
82 ;;; a macro to a lambda or vice versa, | 84 ;;; a macro to a lambda or vice versa, |
83 ;;; or redefined to take other args) | 85 ;;; or redefined to take other args) |
84 ;;; This defaults to nil in -batch mode, which is | 86 ;;; This defaults to nil in -batch mode, which is |
85 ;;; slightly faster. | 87 ;;; slightly faster. |
86 ;;; byte-compile-emacs18-compatibility Whether the compiler should | 88 ;;; byte-compile-compatibility Whether the compiler should |
87 ;;; generate .elc files which can be loaded into | 89 ;;; generate .elc files which can be loaded into |
88 ;;; generic emacs 18's which don't have the file | 90 ;;; generic emacs 18. |
89 ;;; bytecomp-runtime.el loaded as well; | |
90 ;;; byte-compile-generate-emacs19-bytecodes Whether to generate bytecodes | |
91 ;;; which exist only in emacs19. This is a more | |
92 ;;; extreme step than setting emacs18-compatibility | |
93 ;;; to nil, because there is no elisp you can load | |
94 ;;; into an emacs18 to make files compiled this | |
95 ;;; way work. | |
96 ;;; byte-compile-single-version Normally the byte-compiler will consult the | 91 ;;; byte-compile-single-version Normally the byte-compiler will consult the |
97 ;;; above two variables at runtime, but if this | 92 ;;; above two variables at runtime, but if this |
98 ;;; variable is true when the compiler itself is | 93 ;;; variable is true when the compiler itself is |
99 ;;; compiled, then the runtime checks will not be | 94 ;;; compiled, then the runtime checks will not be |
100 ;;; made, and compilation will be slightly faster. | 95 ;;; made, and compilation will be slightly faster. |
101 ;;; elisp-source-extention-re Regexp for the extention of elisp source-files; | |
102 ;;; see also the function byte-compile-dest-file. | |
103 ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. | 96 ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. |
104 ;;; | |
105 ;;; Most of the above parameters can also be set on a file-by-file basis; see | |
106 ;;; the documentation of the `byte-compiler-options' macro. | |
107 | 97 |
108 ;;; New Features: | 98 ;;; New Features: |
109 ;;; | 99 ;;; |
110 ;;; o The form `defsubst' is just like `defun', except that the function | 100 ;;; o The form `defsubst' is just like `defun', except that the function |
111 ;;; generated will be open-coded in compiled code which uses it. This | 101 ;;; generated will be open-coded in compiled code which uses it. This |
112 ;;; means that no function call will be generated, it will simply be | 102 ;;; means that no function call will be generated, it will simply be |
113 ;;; spliced in. Elisp functions calls are very slow, so this can be a | 103 ;;; spliced in. Lisp functions calls are very slow, so this can be a |
114 ;;; big win. | 104 ;;; big win. |
115 ;;; | 105 ;;; |
116 ;;; You can generally accomplish the same thing with `defmacro', but in | 106 ;;; You can generally accomplish the same thing with `defmacro', but in |
117 ;;; that case, the defined procedure can't be used as an argument to | 107 ;;; that case, the defined procedure can't be used as an argument to |
118 ;;; mapcar, etc. | 108 ;;; mapcar, etc. |
119 ;;; | |
120 ;;; o You can make a given function be inline even if it has already been | |
121 ;;; defined with `defun' by using the `proclaim-inline' form like so: | |
122 ;;; (proclaim-inline my-function) | |
123 ;;; This is, in fact, exactly what `defsubst' does. To make a function no | |
124 ;;; longer be inline, you must use `proclaim-notinline'. Beware that if | |
125 ;;; you define a function with `defsubst' and later redefine it with | |
126 ;;; `defun', it will still be open-coded until you use proclaim-notinline. | |
127 ;;; | 109 ;;; |
128 ;;; o You can also open-code one particular call to a function without | 110 ;;; o You can also open-code one particular call to a function without |
129 ;;; open-coding all calls. Use the 'inline' form to do this, like so: | 111 ;;; open-coding all calls. Use the 'inline' form to do this, like so: |
130 ;;; | 112 ;;; |
131 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded | 113 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded |
151 ;;; o The form `eval-and-compile' is similar to eval-when-compile, but | 133 ;;; o The form `eval-and-compile' is similar to eval-when-compile, but |
152 ;;; the whole form is evalled both at compile-time and at run-time. | 134 ;;; the whole form is evalled both at compile-time and at run-time. |
153 ;;; | 135 ;;; |
154 ;;; o The command Meta-X byte-compile-and-load-file does what you'd think. | 136 ;;; o The command Meta-X byte-compile-and-load-file does what you'd think. |
155 ;;; | 137 ;;; |
156 ;;; o The command elisp-compile-defun is analogous to eval-defun. | 138 ;;; o The command compile-defun is analogous to eval-defun. |
157 ;;; | 139 ;;; |
158 ;;; o If you run byte-compile-file on a filename which is visited in a | 140 ;;; o If you run byte-compile-file on a filename which is visited in a |
159 ;;; buffer, and that buffer is modified, you are asked whether you want | 141 ;;; buffer, and that buffer is modified, you are asked whether you want |
160 ;;; to save the buffer before compiling. | 142 ;;; to save the buffer before compiling. |
161 | 143 |
162 (or (fboundp 'defsubst) | 144 (or (fboundp 'defsubst) |
163 ;; This really ought to be loaded already! | 145 ;; This really ought to be loaded already! |
164 (load-library "bytecomp-runtime")) | 146 (load-library "byte-run")) |
165 | 147 |
166 (eval-when-compile | 148 ;;; The feature of compiling in a specific target Emacs version |
167 (defvar byte-compile-single-version nil | 149 ;;; has been turned off because compile time options are a bad idea. |
168 "If this is true, the choice of emacs version (v18 or v19) byte-codes will | 150 (defmacro byte-compile-single-version () nil) |
169 be hard-coded into bytecomp when it compiles itself. If the compiler itself | 151 (defmacro byte-compile-version-cond (cond) cond) |
170 is compiled with optimization, this causes a speedup.") | |
171 | |
172 (cond (byte-compile-single-version | |
173 (defmacro byte-compile-single-version () t) | |
174 (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond)))) | |
175 (t | |
176 (defmacro byte-compile-single-version () nil) | |
177 (defmacro byte-compile-version-cond (cond) cond))) | |
178 ) | |
179 | 152 |
180 ;;; The crud you see scattered through this file of the form | 153 ;;; The crud you see scattered through this file of the form |
181 ;;; (or (and (boundp 'epoch::version) epoch::version) | 154 ;;; (or (and (boundp 'epoch::version) epoch::version) |
182 ;;; (string-lessp emacs-version "19")) | 155 ;;; (string-lessp emacs-version "19")) |
183 ;;; is because the Epoch folks couldn't be bothered to follow the | 156 ;;; is because the Epoch folks couldn't be bothered to follow the |
184 ;;; normal emacs version numbering convention. | 157 ;;; normal emacs version numbering convention. |
185 | 158 |
186 (if (byte-compile-version-cond | 159 ;; (if (byte-compile-version-cond |
187 (or (and (boundp 'epoch::version) epoch::version) | 160 ;; (or (and (boundp 'epoch::version) epoch::version) |
188 (string-lessp emacs-version "19"))) | 161 ;; (string-lessp emacs-version "19"))) |
189 (progn | 162 ;; (progn |
190 ;; emacs-18 compatibility. | 163 ;; ;; emacs-18 compatibility. |
191 (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined | 164 ;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined |
192 | 165 ;; |
193 (if (byte-compile-single-version) | 166 ;; (if (byte-compile-single-version) |
194 (defmacro compiled-function-p (x) "Emacs 18 doesn't have these." nil) | 167 ;; (defmacro compiled-function-p (x) "Emacs 18 doesn't have these." nil) |
195 (defun compiled-function-p (x) "Emacs 18 doesn't have these." nil)) | 168 ;; (defun compiled-function-p (x) "Emacs 18 doesn't have these." nil)) |
196 | 169 ;; |
197 (or (and (fboundp 'member) | 170 ;; (or (and (fboundp 'member) |
198 ;; avoid using someone else's possibly bogus definition of this. | 171 ;; ;; avoid using someone else's possibly bogus definition of this. |
199 (subrp (symbol-function 'member))) | 172 ;; (subrp (symbol-function 'member))) |
200 (defun member (elt list) | 173 ;; (defun member (elt list) |
201 "like memq, but uses equal instead of eq. In v19, this is a subr." | 174 ;; "like memq, but uses equal instead of eq. In v19, this is a subr." |
202 (while (and list (not (equal elt (car list)))) | 175 ;; (while (and list (not (equal elt (car list)))) |
203 (setq list (cdr list))) | 176 ;; (setq list (cdr list))) |
204 list)) | 177 ;; list)))) |
205 )) | 178 |
206 | 179 |
207 | 180 (defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms) |
208 (defvar elisp-source-extention-re (if (eq system-type 'vax-vms) | 181 "\\.EL\\(;[0-9]+\\)?$" |
209 "\\.EL\\(;[0-9]+\\)?$" | 182 "\\.el$") |
210 "\\.el$") | 183 "*Regexp which matches Emacs Lisp source files. |
211 "*Regexp which matches the extention of elisp source-files. | 184 You may want to redefine `byte-compile-dest-file' if you change this.") |
212 You may want to redefine defun byte-compile-dest-file to match this.") | |
213 | 185 |
214 (or (fboundp 'byte-compile-dest-file) | 186 (or (fboundp 'byte-compile-dest-file) |
215 ;; The user may want to redefine this along with elisp-source-extention-re, | 187 ;; The user may want to redefine this, |
216 ;; so only define it if it is undefined. | 188 ;; so only define it if it is undefined. |
217 (defun byte-compile-dest-file (filename) | 189 (defun byte-compile-dest-file (filename) |
218 "Converts an emacs-lisp source-filename to a compiled-filename." | 190 "Convert an Emacs Lisp source file name to a compiled file name." |
219 (setq filename (file-name-sans-versions filename)) | 191 (setq filename (file-name-sans-versions filename)) |
220 (cond ((eq system-type 'vax-vms) | 192 (cond ((eq system-type 'vax-vms) |
221 (concat (substring filename 0 (string-match ";" filename)) "c")) | 193 (concat (substring filename 0 (string-match ";" filename)) "c")) |
222 ((string-match elisp-source-extention-re filename) | |
223 (concat (substring filename 0 (match-beginning 0)) ".elc")) | |
224 (t (concat filename "c"))))) | 194 (t (concat filename "c"))))) |
225 | 195 |
226 ;; This can be the 'byte-compile property of any symbol. | 196 ;; This can be the 'byte-compile property of any symbol. |
227 (autoload 'byte-compile-inline-expand "byte-optimize") | 197 (autoload 'byte-compile-inline-expand "byte-opt") |
228 | 198 |
229 ;; This is the entrypoint to the lapcode optimizer pass1. | 199 ;; This is the entrypoint to the lapcode optimizer pass1. |
230 (autoload 'byte-optimize-form "byte-optimize") | 200 (autoload 'byte-optimize-form "byte-opt") |
231 ;; This is the entrypoint to the lapcode optimizer pass2. | 201 ;; This is the entrypoint to the lapcode optimizer pass2. |
232 (autoload 'byte-optimize-lapcode "byte-optimize") | 202 (autoload 'byte-optimize-lapcode "byte-opt") |
233 (autoload 'byte-compile-unfold-lambda "byte-optimize") | 203 (autoload 'byte-compile-unfold-lambda "byte-opt") |
234 | 204 |
235 (defvar byte-compile-verbose | 205 (defvar byte-compile-verbose |
236 (and (not noninteractive) (> baud-rate search-slow-speed)) | 206 (and (not noninteractive) (> baud-rate search-slow-speed)) |
237 "*Non-nil means print messages describing progress of byte-compiler.") | 207 "*Non-nil means print messages describing progress of byte-compiler.") |
238 | 208 |
239 (defvar byte-compile-emacs18-compatibility | 209 (defvar byte-compile-compatibility nil |
240 (or (and (boundp 'epoch::version) epoch::version) | 210 "*Non-nil means generate output that can run in Emacs 18.") |
241 (string-lessp emacs-version "19")) | 211 |
242 "*If this is true, then the byte compiler will generate .elc files which will | 212 ;; (defvar byte-compile-generate-emacs19-bytecodes |
243 work in generic version 18 emacses without having bytecomp-runtime.el loaded. | 213 ;; (not (or (and (boundp 'epoch::version) epoch::version) |
244 If this is false, the generated code will be more efficient in emacs 19, and | 214 ;; (string-lessp emacs-version "19"))) |
245 will be loadable in emacs 18 only if bytecomp-runtime.el is loaded. | 215 ;; "*If this is true, then the byte-compiler will generate bytecode which |
246 See also byte-compile-generate-emacs19-bytecodes.") | 216 ;; makes use of byte-ops which are present only in Emacs 19. Code generated |
247 | 217 ;; this way can never be run in Emacs 18, and may even cause it to crash.") |
248 (defvar byte-compile-generate-emacs19-bytecodes | |
249 (not (or (and (boundp 'epoch::version) epoch::version) | |
250 (string-lessp emacs-version "19"))) | |
251 "*If this is true, then the byte-compiler will generate bytecode which | |
252 makes use of byte-ops which are present only in emacs19. Code generated | |
253 this way can never be run in emacs18, and may even cause it to crash.") | |
254 | 218 |
255 (defvar byte-optimize t | 219 (defvar byte-optimize t |
256 "*If nil, no compile-optimizations will be done. | 220 "*If nil, no compile-optimizations will be done. |
257 Compilation will be faster, generated code will be slower and larger. | 221 Compilation will be faster, generated code will be slower and larger. |
258 This may be nil, t, 'byte, or 'source. If it is 'byte, then only byte-level | 222 This may be nil, t, 'byte, or 'source. If it is 'byte, then only byte-level |
273 of `message.'") | 237 of `message.'") |
274 | 238 |
275 (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved)) | 239 (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved)) |
276 (defvar byte-compile-warnings (not noninteractive) | 240 (defvar byte-compile-warnings (not noninteractive) |
277 "*List of warnings that the byte-compiler should issue (t for all). | 241 "*List of warnings that the byte-compiler should issue (t for all). |
278 See doc of macro byte-compiler-options.") | 242 Valid elements of this list are `callargs', `redefine', `free-vars', |
243 and `unresolved'.") | |
279 | 244 |
280 (defvar byte-compile-generate-call-tree nil | 245 (defvar byte-compile-generate-call-tree nil |
281 "*If this is true, then the compiler will collect statistics on what | 246 "*Non-nil means collect call-graph information when compiling. |
282 functions were called and from where. This will be displayed after the | 247 This records functions were called and from where. |
283 compilation completes. If it is non-nil, but not t, you will be asked | 248 If the value is t, compilation displays the call graph when it finishes. |
284 for whether to display this. | 249 If the value is neither t nor nil, compilation asks you whether to display |
250 the graph. | |
285 | 251 |
286 The call tree only lists functions called, not macros used. Those functions | 252 The call tree only lists functions called, not macros used. Those functions |
287 which the byte-code interpreter knows about directly (eq, cons, etc.) are | 253 which the byte-code interpreter knows about directly (eq, cons, etc.) are |
288 not reported. | 254 not reported. |
289 | 255 |
290 The call tree also lists those functions which are not known to be called | 256 The call tree also lists those functions which are not known to be called |
291 (that is, to which no calls have been compiled.) Functions which can be | 257 \(that is, to which no calls have been compiled.) Functions which can be |
292 invoked interactively are excluded from this list.") | 258 invoked interactively are excluded from this list.") |
293 | 259 |
294 (defconst byte-compile-call-tree nil "Alist of functions and their call tree. | 260 (defconst byte-compile-call-tree nil "Alist of functions and their call tree. |
295 Each element looks like | 261 Each element looks like |
296 | 262 |
299 where CALLERS is a list of functions that call FUNCTION, and CALLS | 265 where CALLERS is a list of functions that call FUNCTION, and CALLS |
300 is a list of functions for which calls were generated while compiling | 266 is a list of functions for which calls were generated while compiling |
301 FUNCTION.") | 267 FUNCTION.") |
302 | 268 |
303 (defvar byte-compile-call-tree-sort 'name | 269 (defvar byte-compile-call-tree-sort 'name |
304 "*If non nil, the call tree is sorted. | 270 "*If non-nil, sort the call tree. |
305 The values 'name, 'callers, 'calls, 'calls+callers means to sort on | 271 The values `name', `callers', `calls', `calls+callers' |
306 the those fields.") | 272 specify different fields to sort on.") |
307 | 273 |
308 (defvar byte-compile-overwrite-file t | 274 ;; (defvar byte-compile-overwrite-file t |
309 "If nil, old .elc files are deleted before the new is saved, and .elc | 275 ;; "If nil, old .elc files are deleted before the new is saved, and .elc |
310 files will have the same modes as the corresponding .el file. Otherwise, | 276 ;; files will have the same modes as the corresponding .el file. Otherwise, |
311 existing .elc files will simply be overwritten, and the existing modes | 277 ;; existing .elc files will simply be overwritten, and the existing modes |
312 will not be changed. If this variable is nil, then an .elc file which | 278 ;; will not be changed. If this variable is nil, then an .elc file which |
313 is a symbolic link will be turned into a normal file, instead of the file | 279 ;; is a symbolic link will be turned into a normal file, instead of the file |
314 which the link points to being overwritten.") | 280 ;; which the link points to being overwritten.") |
315 | 281 |
316 (defvar byte-compile-constants nil | 282 (defvar byte-compile-constants nil |
317 "list of all constants encountered during compilation of this form") | 283 "list of all constants encountered during compilation of this form") |
318 (defvar byte-compile-variables nil | 284 (defvar byte-compile-variables nil |
319 "list of all variables encountered during compilation of this form") | 285 "list of all variables encountered during compilation of this form") |
322 lives partly on the stack.") | 288 lives partly on the stack.") |
323 (defvar byte-compile-free-references) | 289 (defvar byte-compile-free-references) |
324 (defvar byte-compile-free-assignments) | 290 (defvar byte-compile-free-assignments) |
325 | 291 |
326 (defconst byte-compile-initial-macro-environment | 292 (defconst byte-compile-initial-macro-environment |
327 '((byte-compiler-options . (lambda (&rest forms) | 293 '( |
328 (apply 'byte-compiler-options-handler forms))) | 294 ;; (byte-compiler-options . (lambda (&rest forms) |
295 ;; (apply 'byte-compiler-options-handler forms))) | |
329 (eval-when-compile . (lambda (&rest body) | 296 (eval-when-compile . (lambda (&rest body) |
330 (list 'quote (eval (byte-compile-top-level | 297 (list 'quote (eval (byte-compile-top-level |
331 (cons 'progn body)))))) | 298 (cons 'progn body)))))) |
332 (eval-and-compile . (lambda (&rest body) | 299 (eval-and-compile . (lambda (&rest body) |
333 (eval (cons 'progn body)) | 300 (eval (cons 'progn body)) |
335 "The default macro-environment passed to macroexpand by the compiler. | 302 "The default macro-environment passed to macroexpand by the compiler. |
336 Placing a macro here will cause a macro to have different semantics when | 303 Placing a macro here will cause a macro to have different semantics when |
337 expanded by the compiler as when expanded by the interpreter.") | 304 expanded by the compiler as when expanded by the interpreter.") |
338 | 305 |
339 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment | 306 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment |
340 "Alist of (MACRONAME . DEFINITION) macros defined in the file which is being | 307 "Alist of macros defined in the file being compiled. |
341 compiled. It is (MACRONAME . nil) when a macro is redefined as a function.") | 308 Each element looks like (MACRONAME . DEFINITION). It is |
309 \(MACRONAME . nil) when a function is redefined as a function.") | |
342 | 310 |
343 (defvar byte-compile-function-environment nil | 311 (defvar byte-compile-function-environment nil |
344 "Alist of (FUNCTIONNAME . DEFINITION) functions defined in the file which | 312 "Alist of functions defined in the file being compiled. |
345 is being compiled (this is so we can inline them if necessary). It is | 313 This is so we can inline them when necessary. |
346 (FUNCTIONNAME . nil) when a function is redefined as a macro.") | 314 Each element looks like (FUNCTIONNAME . DEFINITION). It is |
315 \(FUNCTIONNAME . nil) when a function is redefined as a macro.") | |
347 | 316 |
348 (defvar byte-compile-unresolved-functions nil | 317 (defvar byte-compile-unresolved-functions nil |
349 "Alist of undefined functions to which calls have been compiled (used for | 318 "Alist of undefined functions to which calls have been compiled (used for |
350 warnings when the function is later defined with incorrect args).") | 319 warnings when the function is later defined with incorrect args).") |
351 | 320 |
512 (byte-defop 141 -1 byte-catch | 481 (byte-defop 141 -1 byte-catch |
513 "for catch. Takes, on stack, the tag and an expression for the body") | 482 "for catch. Takes, on stack, the tag and an expression for the body") |
514 (byte-defop 142 -1 byte-unwind-protect | 483 (byte-defop 142 -1 byte-unwind-protect |
515 "for unwind-protect. Takes, on stack, an expression for the unwind-action") | 484 "for unwind-protect. Takes, on stack, an expression for the unwind-action") |
516 | 485 |
517 (byte-defop 143 -2 byte-condition-case | 486 ;; For condition-case. Takes, on stack, the variable to bind, |
518 "for condition-case. Takes, on stack, the variable to bind, | 487 ;; an expression for the body, and a list of clauses. |
519 an expression for the body, and a list of clauses") | 488 (byte-defop 143 -2 byte-condition-case) |
520 | 489 |
521 (byte-defop 144 0 byte-temp-output-buffer-setup | 490 ;; For entry to with-output-to-temp-buffer. |
522 "for entry to with-output-to-temp-buffer. | 491 ;; Takes, on stack, the buffer name. |
523 Takes, on stack, the buffer name. | 492 ;; Binds standard-output and does some other things. |
524 Binds standard-output and does some other things. | 493 ;; Returns with temp buffer on the stack in place of buffer name. |
525 Returns with temp buffer on the stack in place of buffer name") | 494 (byte-defop 144 0 byte-temp-output-buffer-setup) |
526 | 495 |
527 (byte-defop 145 -1 byte-temp-output-buffer-show | 496 ;; For exit from with-output-to-temp-buffer. |
528 "for exit from with-output-to-temp-buffer. | 497 ;; Expects the temp buffer on the stack underneath value to return. |
529 Expects the temp buffer on the stack underneath value to return. | 498 ;; Pops them both, then pushes the value back on. |
530 Pops them both, then pushes the value back on. | 499 ;; Unbinds standard-output and makes the temp buffer visible. |
531 Unbinds standard-output and makes the temp buffer visible") | 500 (byte-defop 145 -1 byte-temp-output-buffer-show) |
532 | 501 |
533 ;; these ops are new to v19 | 502 ;; these ops are new to v19 |
534 (byte-defop 146 0 byte-unbind-all "to unbind back to the beginning of | 503 |
535 this frame. Not used yet, but wil be needed for tail-recursion elimination.") | 504 ;; To unbind back to the beginning of this frame. |
505 ;; Not used yet, but wil be needed for tail-recursion elimination. | |
506 (byte-defop 146 0 byte-unbind-all) | |
536 | 507 |
537 ;; these ops are new to v19 | 508 ;; these ops are new to v19 |
538 (byte-defop 147 -2 byte-set-marker) | 509 (byte-defop 147 -2 byte-set-marker) |
539 (byte-defop 148 0 byte-match-beginning) | 510 (byte-defop 148 0 byte-match-beginning) |
540 (byte-defop 149 0 byte-match-end) | 511 (byte-defop 149 0 byte-match-end) |
579 "Exclusive maximum index usable in the `byte-constant' opcode.") | 550 "Exclusive maximum index usable in the `byte-constant' opcode.") |
580 | 551 |
581 (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil | 552 (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil |
582 byte-goto-if-nil-else-pop | 553 byte-goto-if-nil-else-pop |
583 byte-goto-if-not-nil-else-pop) | 554 byte-goto-if-not-nil-else-pop) |
584 "those byte-codes whose offset is a pc.") | 555 "List of byte-codes whose offset is a pc.") |
585 | 556 |
586 (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) | 557 (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) |
587 | 558 |
588 (defconst byte-rel-goto-ops '(byte-rel-goto | 559 (defconst byte-rel-goto-ops '(byte-rel-goto |
589 byte-rel-goto-if-nil byte-rel-goto-if-not-nil | 560 byte-rel-goto-if-nil byte-rel-goto-if-not-nil |
590 byte-rel-goto-if-nil-else-pop | 561 byte-rel-goto-if-nil-else-pop |
591 byte-rel-goto-if-not-nil-else-pop) | 562 byte-rel-goto-if-not-nil-else-pop) |
592 "byte-codes for relative jumps.") | 563 "List of byte-codes for relative jumps.") |
593 | 564 |
594 (byte-extrude-byte-code-vectors) | 565 (byte-extrude-byte-code-vectors) |
595 | 566 |
596 ;;; lapcode generator | 567 ;;; lapcode generator |
597 ;;; | 568 ;;; |
634 rest rel tmp) | 605 rest rel tmp) |
635 (while lap | 606 (while lap |
636 (setq op (car (car lap)) | 607 (setq op (car (car lap)) |
637 off (cdr (car lap))) | 608 off (cdr (car lap))) |
638 (cond ((not (symbolp op)) | 609 (cond ((not (symbolp op)) |
639 (error "non-symbolic opcode %s" op)) | 610 (error "Non-symbolic opcode `%s'" op)) |
640 ((eq op 'TAG) | 611 ((eq op 'TAG) |
641 (setcar off pc) | 612 (setcar off pc) |
642 (setq patchlist (cons off patchlist))) | 613 (setq patchlist (cons off patchlist))) |
643 ((memq op byte-goto-ops) | 614 ((memq op byte-goto-ops) |
644 (setq pc (+ pc 3)) | 615 (setq pc (+ pc 3)) |
675 (cons (logand off 255) | 646 (cons (logand off 255) |
676 (cons (+ (symbol-value op) 7) | 647 (cons (+ (symbol-value op) 7) |
677 bytes)))))))) | 648 bytes)))))))) |
678 (setq lap (cdr lap))) | 649 (setq lap (cdr lap))) |
679 ;;(if (not (= pc (length bytes))) | 650 ;;(if (not (= pc (length bytes))) |
680 ;; (error "compiler error: pc mismatch - %s %s" pc (length bytes))) | 651 ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) |
681 (cond ((byte-compile-version-cond byte-compile-generate-emacs19-bytecodes) | 652 (cond ((byte-compile-version-cond byte-compile-compatibility) |
682 ;; Make relative jumps | 653 ;; Make relative jumps |
683 (setq patchlist (nreverse patchlist)) | 654 (setq patchlist (nreverse patchlist)) |
684 (while (progn | 655 (while (progn |
685 (setq off 0) ; PC change because of deleted bytes | 656 (setq off 0) ; PC change because of deleted bytes |
686 (setq rest patchlist) | 657 (setq rest patchlist) |
798 (format "use %s instead." (car new)))) | 769 (format "use %s instead." (car new)))) |
799 (funcall (or (cdr new) 'byte-compile-normal-call) form))) | 770 (funcall (or (cdr new) 'byte-compile-normal-call) form))) |
800 | 771 |
801 ;; Compiler options | 772 ;; Compiler options |
802 | 773 |
803 (defvar byte-compiler-legal-options | 774 ;; (defvar byte-compiler-valid-options |
804 '((optimize byte-optimize (t nil source byte) val) | 775 ;; '((optimize byte-optimize (t nil source byte) val) |
805 (file-format byte-compile-emacs18-compatibility (emacs18 emacs19) | 776 ;; (file-format byte-compile-compatibility (emacs18 emacs19) |
806 (eq val 'emacs18)) | 777 ;; (eq val 'emacs18)) |
807 (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val) | 778 ;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val) |
808 (delete-errors byte-compile-delete-errors (t nil) val) | 779 ;; (delete-errors byte-compile-delete-errors (t nil) val) |
809 (verbose byte-compile-verbose (t nil) val) | 780 ;; (verbose byte-compile-verbose (t nil) val) |
810 (warnings byte-compile-warnings ((callargs redefine free-vars unresolved)) | 781 ;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved)) |
811 val))) | 782 ;; val))) |
812 | 783 |
813 ;; Inhibit v18/v19 selectors if the version is hardcoded. | 784 ;; Inhibit v18/v19 selectors if the version is hardcoded. |
814 ;; #### This should print a warning if the user tries to change something | 785 ;; #### This should print a warning if the user tries to change something |
815 ;; than can't be changed because the running compiler doesn't support it. | 786 ;; than can't be changed because the running compiler doesn't support it. |
816 (cond | 787 ;; (cond |
817 ((byte-compile-single-version) | 788 ;; ((byte-compile-single-version) |
818 (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-legal-options))) | 789 ;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options))) |
819 (list (byte-compile-version-cond | 790 ;; (list (byte-compile-version-cond |
820 byte-compile-generate-emacs19-bytecodes))) | 791 ;; byte-compile-generate-emacs19-bytecodes))) |
821 (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options))) | 792 ;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options))) |
822 (if (byte-compile-version-cond byte-compile-emacs18-compatibility) | 793 ;; (if (byte-compile-version-cond byte-compile-compatibility) |
823 '(emacs18) '(emacs19))))) | 794 ;; '(emacs18) '(emacs19))))) |
824 | 795 |
825 (defun byte-compiler-options-handler (&rest args) | 796 ;; (defun byte-compiler-options-handler (&rest args) |
826 (let (key val desc choices) | 797 ;; (let (key val desc choices) |
827 (while args | 798 ;; (while args |
828 (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) | 799 ;; (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) |
829 (error "malformed byte-compiler-option %s" (car args))) | 800 ;; (error "Malformed byte-compiler option `%s'" (car args))) |
830 (setq key (car (car args)) | 801 ;; (setq key (car (car args)) |
831 val (car (cdr (car args))) | 802 ;; val (car (cdr (car args))) |
832 desc (assq key byte-compiler-legal-options)) | 803 ;; desc (assq key byte-compiler-valid-options)) |
833 (or desc | 804 ;; (or desc |
834 (error "unknown byte-compiler option %s" key)) | 805 ;; (error "Unknown byte-compiler option `%s'" key)) |
835 (setq choices (nth 2 desc)) | 806 ;; (setq choices (nth 2 desc)) |
836 (if (consp (car choices)) | 807 ;; (if (consp (car choices)) |
837 (let (this | 808 ;; (let (this |
838 (handler 'cons) | 809 ;; (handler 'cons) |
839 (ret (and (memq (car val) '(+ -)) | 810 ;; (ret (and (memq (car val) '(+ -)) |
840 (copy-sequence (if (eq t (symbol-value (nth 1 desc))) | 811 ;; (copy-sequence (if (eq t (symbol-value (nth 1 desc))) |
841 choices | 812 ;; choices |
842 (symbol-value (nth 1 desc))))))) | 813 ;; (symbol-value (nth 1 desc))))))) |
843 (setq choices (car choices)) | 814 ;; (setq choices (car choices)) |
844 (while val | 815 ;; (while val |
845 (setq this (car val)) | 816 ;; (setq this (car val)) |
846 (cond ((memq this choices) | 817 ;; (cond ((memq this choices) |
847 (setq ret (funcall handler this ret))) | 818 ;; (setq ret (funcall handler this ret))) |
848 ((eq this '+) (setq handler 'cons)) | 819 ;; ((eq this '+) (setq handler 'cons)) |
849 ((eq this '-) (setq handler 'delq)) | 820 ;; ((eq this '-) (setq handler 'delq)) |
850 ((error "%s only accepts %s." key choices))) | 821 ;; ((error "`%s' only accepts %s" key choices))) |
851 (setq val (cdr val))) | 822 ;; (setq val (cdr val))) |
852 (set (nth 1 desc) ret)) | 823 ;; (set (nth 1 desc) ret)) |
853 (or (memq val choices) | 824 ;; (or (memq val choices) |
854 (error "%s must be one of %s." key choices)) | 825 ;; (error "`%s' must be one of `%s'" key choices)) |
855 (set (nth 1 desc) (eval (nth 3 desc)))) | 826 ;; (set (nth 1 desc) (eval (nth 3 desc)))) |
856 (setq args (cdr args))) | 827 ;; (setq args (cdr args))) |
857 nil)) | 828 ;; nil)) |
858 | 829 |
859 ;;; sanity-checking arglists | 830 ;;; sanity-checking arglists |
860 | 831 |
861 (defun byte-compile-fdefinition (name macro-p) | 832 (defun byte-compile-fdefinition (name macro-p) |
862 (let* ((list (if macro-p | 833 (let* ((list (if macro-p |
917 ((= (car signature) (cdr signature)) | 888 ((= (car signature) (cdr signature)) |
918 (format "%d" (car signature))) | 889 (format "%d" (car signature))) |
919 (t (format "%d-%d" (car signature) (cdr signature))))) | 890 (t (format "%d-%d" (car signature) (cdr signature))))) |
920 | 891 |
921 | 892 |
893 ;; Warn if the form is calling a function with the wrong number of arguments. | |
922 (defun byte-compile-callargs-warn (form) | 894 (defun byte-compile-callargs-warn (form) |
923 "warn if the form is calling a function with the wrong number of arguments." | |
924 (let* ((def (or (byte-compile-fdefinition (car form) nil) | 895 (let* ((def (or (byte-compile-fdefinition (car form) nil) |
925 (byte-compile-fdefinition (car form) t))) | 896 (byte-compile-fdefinition (car form) t))) |
926 (sig (and def (byte-compile-arglist-signature | 897 (sig (and def (byte-compile-arglist-signature |
927 (if (eq 'lambda (car-safe def)) | 898 (if (eq 'lambda (car-safe def)) |
928 (nth 1 def) | 899 (nth 1 def) |
949 (setcdr cons (cons n (cdr cons)))) | 920 (setcdr cons (cons n (cdr cons)))) |
950 (setq byte-compile-unresolved-functions | 921 (setq byte-compile-unresolved-functions |
951 (cons (list (car form) n) | 922 (cons (list (car form) n) |
952 byte-compile-unresolved-functions)))))))) | 923 byte-compile-unresolved-functions)))))))) |
953 | 924 |
925 ;; Warn if the function or macro is being redefined with a different | |
926 ;; number of arguments. | |
954 (defun byte-compile-arglist-warn (form macrop) | 927 (defun byte-compile-arglist-warn (form macrop) |
955 "warn if the function or macro is being redefined with a different | |
956 number of arguments." | |
957 (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) | 928 (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) |
958 (if old | 929 (if old |
959 (let ((sig1 (byte-compile-arglist-signature | 930 (let ((sig1 (byte-compile-arglist-signature |
960 (if (eq 'lambda (car-safe old)) | 931 (if (eq 'lambda (car-safe old)) |
961 (nth 1 old) | 932 (nth 1 old) |
988 | 959 |
989 (setq byte-compile-unresolved-functions | 960 (setq byte-compile-unresolved-functions |
990 (delq calls byte-compile-unresolved-functions))))) | 961 (delq calls byte-compile-unresolved-functions))))) |
991 ))) | 962 ))) |
992 | 963 |
964 ;; If we have compiled any calls to functions which are not known to be | |
965 ;; defined, issue a warning enumerating them. | |
966 ;; `unresolved' in the list `byte-compile-warnings' disables this. | |
993 (defun byte-compile-warn-about-unresolved-functions () | 967 (defun byte-compile-warn-about-unresolved-functions () |
994 "If we have compiled any calls to functions which are not known to be | |
995 defined, issue a warning enumerating them. You can disable this by including | |
996 'unresolved in variable byte-compile-warnings." | |
997 (if (memq 'unresolved byte-compile-warnings) | 968 (if (memq 'unresolved byte-compile-warnings) |
998 (let ((byte-compile-current-form "the end of the data")) | 969 (let ((byte-compile-current-form "the end of the data")) |
999 (if (cdr byte-compile-unresolved-functions) | 970 (if (cdr byte-compile-unresolved-functions) |
1000 (let* ((str "The following functions are not known to be defined: ") | 971 (let* ((str "The following functions are not known to be defined: ") |
1001 (L (length str)) | 972 (L (length str)) |
1040 ;; Close over these variables so that `byte-compiler-options' | 1011 ;; Close over these variables so that `byte-compiler-options' |
1041 ;; can change them on a per-file basis. | 1012 ;; can change them on a per-file basis. |
1042 ;; | 1013 ;; |
1043 (byte-compile-verbose byte-compile-verbose) | 1014 (byte-compile-verbose byte-compile-verbose) |
1044 (byte-optimize byte-optimize) | 1015 (byte-optimize byte-optimize) |
1045 (byte-compile-generate-emacs19-bytecodes | 1016 ;; (byte-compile-generate-emacs19-bytecodes |
1046 byte-compile-generate-emacs19-bytecodes) | 1017 ;; byte-compile-generate-emacs19-bytecodes) |
1047 (byte-compile-warnings (if (eq byte-compile-warnings t) | 1018 (byte-compile-warnings (if (eq byte-compile-warnings t) |
1048 byte-compile-warning-types | 1019 byte-compile-warning-types |
1049 byte-compile-warnings)) | 1020 byte-compile-warnings)) |
1050 ) | 1021 ) |
1051 body))) | 1022 body))) |
1081 for each such `.el' file, whether to compile it." | 1052 for each such `.el' file, whether to compile it." |
1082 (interactive "DByte recompile directory: \nP") | 1053 (interactive "DByte recompile directory: \nP") |
1083 (save-some-buffers) | 1054 (save-some-buffers) |
1084 (set-buffer-modified-p (buffer-modified-p)) ;Update the mode line. | 1055 (set-buffer-modified-p (buffer-modified-p)) ;Update the mode line. |
1085 (setq directory (expand-file-name directory)) | 1056 (setq directory (expand-file-name directory)) |
1086 (let ((files (directory-files directory nil elisp-source-extention-re)) | 1057 (let ((files (directory-files directory nil emacs-lisp-file-regexp)) |
1087 (count 0) | 1058 (count 0) |
1088 source dest) | 1059 source dest) |
1089 (while files | 1060 (while files |
1090 (if (and (not (auto-save-file-name-p (car files))) | 1061 (if (and (not (auto-save-file-name-p (car files))) |
1091 (setq source (expand-file-name (car files) directory)) | 1062 (setq source (expand-file-name (car files) directory)) |
1111 (and file | 1082 (and file |
1112 (eq (cdr (assq 'major-mode (buffer-local-variables))) | 1083 (eq (cdr (assq 'major-mode (buffer-local-variables))) |
1113 'emacs-lisp-mode) | 1084 'emacs-lisp-mode) |
1114 (setq file-name (file-name-nondirectory file) | 1085 (setq file-name (file-name-nondirectory file) |
1115 file-dir (file-name-directory file))) | 1086 file-dir (file-name-directory file))) |
1116 (list (if (byte-compile-version-cond | 1087 (list (read-file-name (if current-prefix-arg |
1117 (or (and (boundp 'epoch::version) epoch::version) | 1088 "Byte compile and load file: " |
1118 (string-lessp emacs-version "19"))) | 1089 "Byte compile file: ") |
1119 (read-file-name (if current-prefix-arg | 1090 file-dir file-name nil)) |
1120 "Byte compile and load file: " | 1091 current-prefix-arg)) |
1121 "Byte compile file: ") | |
1122 file-dir file-name nil) | |
1123 (read-file-name (if current-prefix-arg | |
1124 "Byte compile and load file: " | |
1125 "Byte compile file: ") | |
1126 file-dir nil nil file-name)) | |
1127 current-prefix-arg))) | |
1128 ;; Expand now so we get the current buffer's defaults | 1092 ;; Expand now so we get the current buffer's defaults |
1129 (setq filename (expand-file-name filename)) | 1093 (setq filename (expand-file-name filename)) |
1130 | 1094 |
1131 ;; If we're compiling a file that's in a buffer and is modified, offer | 1095 ;; If we're compiling a file that's in a buffer and is modified, offer |
1132 ;; to save it first. | 1096 ;; to save it first. |
1153 (set-buffer (byte-compile-from-buffer (current-buffer))))) | 1117 (set-buffer (byte-compile-from-buffer (current-buffer))))) |
1154 (goto-char (point-max)) | 1118 (goto-char (point-max)) |
1155 (insert "\n") ; aaah, unix. | 1119 (insert "\n") ; aaah, unix. |
1156 (let ((vms-stmlf-recfm t)) | 1120 (let ((vms-stmlf-recfm t)) |
1157 (setq target-file (byte-compile-dest-file filename)) | 1121 (setq target-file (byte-compile-dest-file filename)) |
1158 (or byte-compile-overwrite-file | 1122 ;; (or byte-compile-overwrite-file |
1159 (condition-case () | 1123 ;; (condition-case () |
1160 (delete-file target-file) | 1124 ;; (delete-file target-file) |
1161 (error nil))) | 1125 ;; (error nil))) |
1162 (if (file-writable-p target-file) | 1126 (if (file-writable-p target-file) |
1163 (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki | 1127 (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki |
1164 (write-region 1 (point-max) target-file)) | 1128 (write-region 1 (point-max) target-file)) |
1165 ;; This is just to give a better error message than write-region | 1129 ;; This is just to give a better error message than write-region |
1166 (signal 'file-error (list "Opening output file" | 1130 (signal 'file-error (list "Opening output file" |
1167 (if (file-exists-p target-file) | 1131 (if (file-exists-p target-file) |
1168 "cannot overwrite file" | 1132 "cannot overwrite file" |
1169 "directory not writable or nonexistent") | 1133 "directory not writable or nonexistent") |
1170 target-file))) | 1134 target-file))) |
1171 (or byte-compile-overwrite-file | 1135 ;; (or byte-compile-overwrite-file |
1172 (condition-case () | 1136 ;; (condition-case () |
1173 (set-file-modes target-file (file-modes filename)) | 1137 ;; (set-file-modes target-file (file-modes filename)) |
1174 (error nil)))) | 1138 ;; (error nil))) |
1139 ) | |
1175 (kill-buffer (current-buffer))) | 1140 (kill-buffer (current-buffer))) |
1176 (if (and byte-compile-generate-call-tree | 1141 (if (and byte-compile-generate-call-tree |
1177 (or (eq t byte-compile-generate-call-tree) | 1142 (or (eq t byte-compile-generate-call-tree) |
1178 (y-or-n-p (format "Report call tree for %s? " filename)))) | 1143 (y-or-n-p (format "Report call tree for %s? " filename)))) |
1179 (save-excursion | 1144 (save-excursion |
1180 (byte-compile-report-call-tree filename))) | 1145 (byte-compile-report-call-tree filename))) |
1181 (if load | 1146 (if load |
1182 (load target-file))) | 1147 (load target-file))) |
1183 t) | 1148 t) |
1184 | 1149 |
1185 (defun byte-compile-and-load-file (&optional filename) | 1150 ;;(defun byte-compile-and-load-file (&optional filename) |
1186 "Compile a file of Lisp code named FILENAME into a file of byte code, | 1151 ;; "Compile a file of Lisp code named FILENAME into a file of byte code, |
1187 and then load it. The output file's name is made by appending \"c\" to | 1152 ;;and then load it. The output file's name is made by appending \"c\" to |
1188 the end of FILENAME." | 1153 ;;the end of FILENAME." |
1189 (interactive) | 1154 ;; (interactive) |
1190 (if filename ; I don't get it, (interactive-p) doesn't always work | 1155 ;; (if filename ; I don't get it, (interactive-p) doesn't always work |
1191 (byte-compile-file filename t) | 1156 ;; (byte-compile-file filename t) |
1192 (let ((current-prefix-arg '(4))) | 1157 ;; (let ((current-prefix-arg '(4))) |
1193 (call-interactively 'byte-compile-file)))) | 1158 ;; (call-interactively 'byte-compile-file)))) |
1194 | 1159 |
1195 | 1160 ;;(defun byte-compile-buffer (&optional buffer) |
1196 (defun byte-compile-buffer (&optional buffer) | 1161 ;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." |
1197 "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." | 1162 ;; (interactive "bByte compile buffer: ") |
1198 (interactive "bByte compile buffer: ") | 1163 ;; (setq buffer (if buffer (get-buffer buffer) (current-buffer))) |
1199 (setq buffer (if buffer (get-buffer buffer) (current-buffer))) | 1164 ;; (message "Compiling %s..." (buffer-name buffer)) |
1200 (message "Compiling %s..." (buffer-name buffer)) | 1165 ;; (let* ((filename (or (buffer-file-name buffer) |
1201 (let* ((filename (or (buffer-file-name buffer) | 1166 ;; (concat "#<buffer " (buffer-name buffer) ">"))) |
1202 (concat "#<buffer " (buffer-name buffer) ">"))) | 1167 ;; (byte-compile-current-file buffer)) |
1203 (byte-compile-current-file buffer)) | 1168 ;; (byte-compile-from-buffer buffer t)) |
1204 (byte-compile-from-buffer buffer t)) | 1169 ;; (message "Compiling %s...done" (buffer-name buffer)) |
1205 (message "Compiling %s...done" (buffer-name buffer)) | 1170 ;; t) |
1206 t) | |
1207 | 1171 |
1208 ;;; compiling a single function | 1172 ;;; compiling a single function |
1209 (defun elisp-compile-defun (&optional arg) | 1173 (defun compile-defun (&optional arg) |
1210 "Compile and evaluate the current top-level form. | 1174 "Compile and evaluate the current top-level form. |
1211 Print the result in the minibuffer. | 1175 Print the result in the minibuffer. |
1212 With argument, insert value in current buffer after the form." | 1176 With argument, insert value in current buffer after the form." |
1213 (interactive "P") | 1177 (interactive "P") |
1214 (save-excursion | 1178 (save-excursion |
1291 (cond | 1255 (cond |
1292 ((eq byte-optimize 'source) "source-level optimization only") | 1256 ((eq byte-optimize 'source) "source-level optimization only") |
1293 ((eq byte-optimize 'byte) "byte-level optimization only") | 1257 ((eq byte-optimize 'byte) "byte-level optimization only") |
1294 (byte-optimize "optimization is on") | 1258 (byte-optimize "optimization is on") |
1295 (t "optimization is off")) | 1259 (t "optimization is off")) |
1296 (if (byte-compile-version-cond byte-compile-emacs18-compatibility) | 1260 (if (byte-compile-version-cond byte-compile-compatibility) |
1297 "; compiled with emacs18 compatibility.\n" | 1261 "; compiled with Emacs 18 compatibility.\n" |
1298 ".\n")) | 1262 ".\n")) |
1299 (if (byte-compile-version-cond byte-compile-generate-emacs19-bytecodes) | 1263 (if (byte-compile-version-cond byte-compile-compatibility) |
1300 (insert ";;; this file uses opcodes which do not exist in Emacs18.\n" | 1264 (insert ";;; this file uses opcodes which do not exist in Emacs 18.\n" |
1301 ;; Have to check if emacs-version is bound so that this works | 1265 ;; Have to check if emacs-version is bound so that this works |
1302 ;; in files loaded early in loadup.el. | 1266 ;; in files loaded early in loadup.el. |
1303 "\n(if (and (boundp 'emacs-version)\n" | 1267 "\n(if (and (boundp 'emacs-version)\n" |
1304 "\t (or (and (boundp 'epoch::version) epoch::version)\n" | 1268 "\t (or (and (boundp 'epoch::version) epoch::version)\n" |
1305 "\t (string-lessp emacs-version \"19\")))\n" | 1269 "\t (string-lessp emacs-version \"19\")))\n" |
1306 " (error \"This file was compiled for Emacs19.\"))\n" | 1270 " (error \"This file was compiled for Emacs 19\"))\n" |
1307 )) | 1271 )) |
1308 )) | 1272 )) |
1309 | 1273 |
1310 | 1274 |
1311 (defun byte-compile-output-file-form (form) | 1275 (defun byte-compile-output-file-form (form) |
1484 (byte-compile-arglist-warn form macrop)) | 1448 (byte-compile-arglist-warn form macrop)) |
1485 (if byte-compile-verbose | 1449 (if byte-compile-verbose |
1486 (message "Compiling %s (%s)..." (or filename "") (nth 1 form))) | 1450 (message "Compiling %s (%s)..." (or filename "") (nth 1 form))) |
1487 (cond (that-one | 1451 (cond (that-one |
1488 (if (and (memq 'redefine byte-compile-warnings) | 1452 (if (and (memq 'redefine byte-compile-warnings) |
1489 ;; don't warn when compiling the stubs in bytecomp-runtime... | 1453 ;; don't warn when compiling the stubs in byte-run... |
1490 (not (assq (nth 1 form) | 1454 (not (assq (nth 1 form) |
1491 byte-compile-initial-macro-environment))) | 1455 byte-compile-initial-macro-environment))) |
1492 (byte-compile-warn | 1456 (byte-compile-warn |
1493 "%s defined multiple times, as both function and macro" | 1457 "%s defined multiple times, as both function and macro" |
1494 (nth 1 form))) | 1458 (nth 1 form))) |
1495 (setcdr that-one nil)) | 1459 (setcdr that-one nil)) |
1496 (this-one | 1460 (this-one |
1497 (if (and (memq 'redefine byte-compile-warnings) | 1461 (if (and (memq 'redefine byte-compile-warnings) |
1498 ;; hack: don't warn when compiling the magic internal | 1462 ;; hack: don't warn when compiling the magic internal |
1499 ;; byte-compiler macros in bytecomp-runtime.el... | 1463 ;; byte-compiler macros in byte-run.el... |
1500 (not (assq (nth 1 form) | 1464 (not (assq (nth 1 form) |
1501 byte-compile-initial-macro-environment))) | 1465 byte-compile-initial-macro-environment))) |
1502 (byte-compile-warn "%s %s defined multiple times in this file" | 1466 (byte-compile-warn "%s %s defined multiple times in this file" |
1503 (if macrop "macro" "function") | 1467 (if macrop "macro" "function") |
1504 (nth 1 form)))) | 1468 (nth 1 form)))) |
1587 (byte-compile-top-level sexp)))) | 1551 (byte-compile-top-level sexp)))) |
1588 | 1552 |
1589 ;; Given a function made by byte-compile-lambda, make a form which produces it. | 1553 ;; Given a function made by byte-compile-lambda, make a form which produces it. |
1590 (defun byte-compile-byte-code-maker (fun) | 1554 (defun byte-compile-byte-code-maker (fun) |
1591 (cond | 1555 (cond |
1592 ((byte-compile-version-cond byte-compile-emacs18-compatibility) | 1556 ((byte-compile-version-cond byte-compile-compatibility) |
1593 ;; Return (quote (lambda ...)). | 1557 ;; Return (quote (lambda ...)). |
1594 (list 'quote (byte-compile-byte-code-unmake fun))) | 1558 (list 'quote (byte-compile-byte-code-unmake fun))) |
1595 ;; ## atom is faster than compiled-func-p. | 1559 ;; ## atom is faster than compiled-func-p. |
1596 ((atom fun) ; compiled function. | 1560 ((atom fun) ; compiled function. |
1597 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda | 1561 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda |
1598 ;; would have produced a lambda. | 1562 ;; would have produced a lambda. |
1599 fun) | 1563 fun) |
1600 ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial | 1564 ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial |
1601 ;; function, or this is emacs18, or generate-emacs19-bytecodes is off. | 1565 ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. |
1602 ((let (tmp) | 1566 ((let (tmp) |
1603 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) | 1567 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) |
1604 (null (cdr (memq tmp fun)))) | 1568 (null (cdr (memq tmp fun)))) |
1605 ;; Generate a make-byte-code call. | 1569 ;; Generate a make-byte-code call. |
1606 (let* ((interactive (assq 'interactive (cdr (cdr fun))))) | 1570 (let* ((interactive (assq 'interactive (cdr (cdr fun))))) |
1663 (setq int (list 'interactive (byte-compile-top-level | 1627 (setq int (list 'interactive (byte-compile-top-level |
1664 (nth 1 int)))))))) | 1628 (nth 1 int)))))))) |
1665 (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) | 1629 (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) |
1666 (if (and (eq 'byte-code (car-safe compiled)) | 1630 (if (and (eq 'byte-code (car-safe compiled)) |
1667 (byte-compile-version-cond | 1631 (byte-compile-version-cond |
1668 byte-compile-generate-emacs19-bytecodes)) | 1632 byte-compile-compatibility)) |
1669 (apply 'make-byte-code | 1633 (apply 'make-byte-code |
1670 (append (list arglist) | 1634 (append (list arglist) |
1671 ;; byte-string, constants-vector, stack depth | 1635 ;; byte-string, constants-vector, stack depth |
1672 (cdr compiled) | 1636 (cdr compiled) |
1673 ;; optionally, the doc string. | 1637 ;; optionally, the doc string. |
1854 ((symbolp (car form)) | 1818 ((symbolp (car form)) |
1855 (let* ((fn (car form)) | 1819 (let* ((fn (car form)) |
1856 (handler (get fn 'byte-compile))) | 1820 (handler (get fn 'byte-compile))) |
1857 (if (and handler | 1821 (if (and handler |
1858 (or (byte-compile-version-cond | 1822 (or (byte-compile-version-cond |
1859 byte-compile-generate-emacs19-bytecodes) | 1823 byte-compile-compatibility) |
1860 (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) | 1824 (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) |
1861 (funcall handler form) | 1825 (funcall handler form) |
1862 (if (memq 'callargs byte-compile-warnings) | 1826 (if (memq 'callargs byte-compile-warnings) |
1863 (byte-compile-callargs-warn form)) | 1827 (byte-compile-callargs-warn form)) |
1864 (byte-compile-normal-call form)))) | 1828 (byte-compile-normal-call form)))) |
1969 ''byte-opcode-invert (list 'quote function))) | 1933 ''byte-opcode-invert (list 'quote function))) |
1970 fnform)))) | 1934 fnform)))) |
1971 | 1935 |
1972 (defmacro byte-defop-compiler19 (function &optional compile-handler) | 1936 (defmacro byte-defop-compiler19 (function &optional compile-handler) |
1973 ;; Just like byte-defop-compiler, but defines an opcode that will only | 1937 ;; Just like byte-defop-compiler, but defines an opcode that will only |
1974 ;; be used when byte-compile-generate-emacs19-bytecodes is true. | 1938 ;; be used when byte-compile-compatibility is true. |
1975 (if (and (byte-compile-single-version) | 1939 (if (and (byte-compile-single-version) |
1976 (not byte-compile-generate-emacs19-bytecodes)) | 1940 (not byte-compile-compatibility)) |
1977 nil | 1941 nil |
1978 (list 'progn | 1942 (list 'progn |
1979 (list 'put | 1943 (list 'put |
1980 (list 'quote | 1944 (list 'quote |
1981 (or (car (cdr-safe function)) | 1945 (or (car (cdr-safe function)) |
2186 ((< count 5) | 2150 ((< count 5) |
2187 (mapcar 'byte-compile-form (cdr form)) | 2151 (mapcar 'byte-compile-form (cdr form)) |
2188 (byte-compile-out | 2152 (byte-compile-out |
2189 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0)) | 2153 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0)) |
2190 ((and (< count 256) (byte-compile-version-cond | 2154 ((and (< count 256) (byte-compile-version-cond |
2191 byte-compile-generate-emacs19-bytecodes)) | 2155 byte-compile-compatibility)) |
2192 (mapcar 'byte-compile-form (cdr form)) | 2156 (mapcar 'byte-compile-form (cdr form)) |
2193 (byte-compile-out 'byte-listN count)) | 2157 (byte-compile-out 'byte-listN count)) |
2194 (t (byte-compile-normal-call form))))) | 2158 (t (byte-compile-normal-call form))))) |
2195 | 2159 |
2196 (defun byte-compile-concat (form) | 2160 (defun byte-compile-concat (form) |
2202 0)) | 2166 0)) |
2203 ;; Concat of one arg is not a no-op if arg is not a string. | 2167 ;; Concat of one arg is not a no-op if arg is not a string. |
2204 ((= count 0) | 2168 ((= count 0) |
2205 (byte-compile-form "")) | 2169 (byte-compile-form "")) |
2206 ((and (< count 256) (byte-compile-version-cond | 2170 ((and (< count 256) (byte-compile-version-cond |
2207 byte-compile-generate-emacs19-bytecodes)) | 2171 byte-compile-compatibility)) |
2208 (mapcar 'byte-compile-form (cdr form)) | 2172 (mapcar 'byte-compile-form (cdr form)) |
2209 (byte-compile-out 'byte-concatN count)) | 2173 (byte-compile-out 'byte-concatN count)) |
2210 ((byte-compile-normal-call form))))) | 2174 ((byte-compile-normal-call form))))) |
2211 | 2175 |
2212 (defun byte-compile-minus (form) | 2176 (defun byte-compile-minus (form) |
2283 (nth 1 form)) | 2247 (nth 1 form)) |
2284 ;; If we're not allowed to use #[] syntax, then output a form like | 2248 ;; If we're not allowed to use #[] syntax, then output a form like |
2285 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code. | 2249 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code. |
2286 ;; In this situation, calling make-byte-code at run-time will usually | 2250 ;; In this situation, calling make-byte-code at run-time will usually |
2287 ;; be less efficient than processing a call to byte-code. | 2251 ;; be less efficient than processing a call to byte-code. |
2288 ((byte-compile-version-cond byte-compile-emacs18-compatibility) | 2252 ((byte-compile-version-cond byte-compile-compatibility) |
2289 (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form)))) | 2253 (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form)))) |
2290 ((byte-compile-lambda (nth 1 form)))))) | 2254 ((byte-compile-lambda (nth 1 form)))))) |
2291 | 2255 |
2292 (defun byte-compile-indent-to (form) | 2256 (defun byte-compile-indent-to (form) |
2293 (let ((len (length form))) | 2257 (let ((len (length form))) |
2302 | 2266 |
2303 (defun byte-compile-insert (form) | 2267 (defun byte-compile-insert (form) |
2304 (cond ((null (cdr form)) | 2268 (cond ((null (cdr form)) |
2305 (byte-compile-constant nil)) | 2269 (byte-compile-constant nil)) |
2306 ((and (byte-compile-version-cond | 2270 ((and (byte-compile-version-cond |
2307 byte-compile-generate-emacs19-bytecodes) | 2271 byte-compile-compatibility) |
2308 (<= (length form) 256)) | 2272 (<= (length form) 256)) |
2309 (mapcar 'byte-compile-form (cdr form)) | 2273 (mapcar 'byte-compile-form (cdr form)) |
2310 (if (cdr (cdr form)) | 2274 (if (cdr (cdr form)) |
2311 (byte-compile-out 'byte-insertN (length (cdr form))) | 2275 (byte-compile-out 'byte-insertN (length (cdr form))) |
2312 (byte-compile-out 'byte-insert 0))) | 2276 (byte-compile-out 'byte-insert 0))) |
2370 (while (cdr body) | 2334 (while (cdr body) |
2371 (byte-compile-form (car body) t) | 2335 (byte-compile-form (car body) t) |
2372 (setq body (cdr body))) | 2336 (setq body (cdr body))) |
2373 (byte-compile-form (car body) for-effect)) | 2337 (byte-compile-form (car body) for-effect)) |
2374 | 2338 |
2375 (proclaim-inline byte-compile-body-do-effect) | 2339 (defsubst byte-compile-body-do-effect (body) |
2376 (defun byte-compile-body-do-effect (body) | |
2377 (byte-compile-body body for-effect) | 2340 (byte-compile-body body for-effect) |
2378 (setq for-effect nil)) | 2341 (setq for-effect nil)) |
2379 | 2342 |
2380 (proclaim-inline byte-compile-form-do-effect) | 2343 (defsubst byte-compile-form-do-effect (form) |
2381 (defun byte-compile-form-do-effect (form) | |
2382 (byte-compile-form form for-effect) | 2344 (byte-compile-form form for-effect) |
2383 (setq for-effect nil)) | 2345 (setq for-effect nil)) |
2384 | 2346 |
2385 (byte-defop-compiler-1 inline byte-compile-progn) | 2347 (byte-defop-compiler-1 inline byte-compile-progn) |
2386 (byte-defop-compiler-1 progn) | 2348 (byte-defop-compiler-1 progn) |
2551 (defun byte-compile-negation-optimizer (form) | 2513 (defun byte-compile-negation-optimizer (form) |
2552 ;; an optimizer for forms where <form1> is less efficient than (not <form2>) | 2514 ;; an optimizer for forms where <form1> is less efficient than (not <form2>) |
2553 (list 'not | 2515 (list 'not |
2554 (cons (or (get (car form) 'byte-compile-negated-op) | 2516 (cons (or (get (car form) 'byte-compile-negated-op) |
2555 (error | 2517 (error |
2556 "compiler error: %s has no byte-compile-negated-op property" | 2518 "Compiler error: `%s' has no `byte-compile-negated-op' property" |
2557 (car form))) | 2519 (car form))) |
2558 (cdr form)))) | 2520 (cdr form)))) |
2559 | 2521 |
2560 ;;; other tricky macro-like special-forms | 2522 ;;; other tricky macro-like special-forms |
2561 | 2523 |
2706 (if (cdr (cdr tag)) | 2668 (if (cdr (cdr tag)) |
2707 (progn | 2669 (progn |
2708 ;; ## remove this someday | 2670 ;; ## remove this someday |
2709 (and byte-compile-depth | 2671 (and byte-compile-depth |
2710 (not (= (cdr (cdr tag)) byte-compile-depth)) | 2672 (not (= (cdr (cdr tag)) byte-compile-depth)) |
2711 (error "bytecomp bug: depth conflict at tag %d" (car (cdr tag)))) | 2673 (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) |
2712 (setq byte-compile-depth (cdr (cdr tag)))) | 2674 (setq byte-compile-depth (cdr (cdr tag)))) |
2713 (setcdr (cdr tag) byte-compile-depth))) | 2675 (setcdr (cdr tag) byte-compile-depth))) |
2714 | 2676 |
2715 (defun byte-compile-goto (opcode tag) | 2677 (defun byte-compile-goto (opcode tag) |
2716 (setq byte-compile-output (cons (cons opcode tag) byte-compile-output)) | 2678 (setq byte-compile-output (cons (cons opcode tag) byte-compile-output)) |
2733 (or (aref byte-stack+-info | 2695 (or (aref byte-stack+-info |
2734 (symbol-value opcode)) | 2696 (symbol-value opcode)) |
2735 (- (1- offset)))) | 2697 (- (1- offset)))) |
2736 byte-compile-maxdepth (max byte-compile-depth | 2698 byte-compile-maxdepth (max byte-compile-depth |
2737 byte-compile-maxdepth)))) | 2699 byte-compile-maxdepth)))) |
2738 ;;(if (< byte-compile-depth 0) (error "compiler error: stack underflow")) | 2700 ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) |
2739 ) | 2701 ) |
2740 | 2702 |
2741 | 2703 |
2742 ;;; call tree stuff | 2704 ;;; call tree stuff |
2743 | 2705 |
2759 (setq byte-compile-call-tree | 2721 (setq byte-compile-call-tree |
2760 (cons (list byte-compile-current-form nil (list (car form))) | 2722 (cons (list byte-compile-current-form nil (list (car form))) |
2761 byte-compile-call-tree))) | 2723 byte-compile-call-tree))) |
2762 )) | 2724 )) |
2763 | 2725 |
2764 (defun byte-compile-report-call-tree (&optional filename) | 2726 ;; Renamed from byte-compile-report-call-tree |
2765 "Display a buffer describing which functions have been called, what functions | 2727 ;; to avoid interfering with completion of byte-compile-file. |
2766 called them, and what functions they call. This buffer will list all functions | 2728 (defun display-call-tree (&optional filename) |
2767 whose definitions have been compiled since this emacs session was started, as | 2729 "Display a call graph of a specified file. |
2768 well as all functions called by those functions. | 2730 This lists which functions have been called, what functions called |
2769 | 2731 them, and what functions they call. The list includes all functions |
2770 The call tree only lists functions called, not macros or inline functions | 2732 whose definitions have been compiled in this Emacs session, as well as |
2771 expanded. Those functions which the byte-code interpreter knows about directly | 2733 all functions called by those functions. |
2772 \(eq, cons, etc.\) are not reported. | 2734 |
2735 The call graph does not include macros, inline functions, or | |
2736 primitives that the byte-code interpreter knows about directly \(eq, | |
2737 cons, etc.\). | |
2773 | 2738 |
2774 The call tree also lists those functions which are not known to be called | 2739 The call tree also lists those functions which are not known to be called |
2775 \(that is, to which no calls have been compiled.\) Functions which can be | 2740 \(that is, to which no calls have been compiled\), and which cannot be |
2776 invoked interactively are excluded from this list." | 2741 invoked interactively." |
2777 (interactive) | 2742 (interactive) |
2778 (message "Generating call tree...") | 2743 (message "Generating call tree...") |
2779 (with-output-to-temp-buffer "*Call-Tree*" | 2744 (with-output-to-temp-buffer "*Call-Tree*" |
2780 (set-buffer "*Call-Tree*") | 2745 (set-buffer "*Call-Tree*") |
2781 (erase-buffer) | 2746 (erase-buffer) |
2804 (+ (length (nth 1 y)) | 2769 (+ (length (nth 1 y)) |
2805 (length (nth 2 y))))))) | 2770 (length (nth 2 y))))))) |
2806 ((eq byte-compile-call-tree-sort 'name) | 2771 ((eq byte-compile-call-tree-sort 'name) |
2807 (function (lambda (x y) (string< (car x) | 2772 (function (lambda (x y) (string< (car x) |
2808 (car y))))) | 2773 (car y))))) |
2809 (t (error "byte-compile-call-tree-sort: %s - unknown sort mode" | 2774 (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" |
2810 byte-compile-call-tree-sort)))))) | 2775 byte-compile-call-tree-sort)))))) |
2811 (message "Generating call tree...") | 2776 (message "Generating call tree...") |
2812 (let ((rest byte-compile-call-tree) | 2777 (let ((rest byte-compile-call-tree) |
2813 (b (current-buffer)) | 2778 (b (current-buffer)) |
2814 f p | 2779 f p |
2887 | 2852 |
2888 | 2853 |
2889 ;;; by crl@newton.purdue.edu | 2854 ;;; by crl@newton.purdue.edu |
2890 ;;; Only works noninteractively. | 2855 ;;; Only works noninteractively. |
2891 (defun batch-byte-compile () | 2856 (defun batch-byte-compile () |
2892 "Runs `byte-compile-file' on the files remaining on the command line. | 2857 "Run `byte-compile-file' on the files remaining on the command line. |
2893 Must be used only with -batch, and kills emacs on completion. | 2858 Use this from the command line, with `-batch'; |
2894 Each file will be processed even if an error occurred previously. | 2859 it won't work in an interactive Emacs. |
2860 Each file is processed even if an error occurred previously. | |
2895 For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" | 2861 For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" |
2896 ;; command-line-args-left is what is left of the command line (from startup.el) | 2862 ;; command-line-args-left is what is left of the command line (from startup.el) |
2897 (defvar command-line-args-left) ;Avoid 'free variable' warning | 2863 (defvar command-line-args-left) ;Avoid 'free variable' warning |
2898 (if (not noninteractive) | 2864 (if (not noninteractive) |
2899 (error "batch-byte-compile is to be used only with -batch")) | 2865 (error "`batch-byte-compile' is to be used only with -batch")) |
2900 (let ((error nil)) | 2866 (let ((error nil)) |
2901 (while command-line-args-left | 2867 (while command-line-args-left |
2902 (if (file-directory-p (expand-file-name (car command-line-args-left))) | 2868 (if (file-directory-p (expand-file-name (car command-line-args-left))) |
2903 (let ((files (directory-files (car command-line-args-left))) | 2869 (let ((files (directory-files (car command-line-args-left))) |
2904 source dest) | 2870 source dest) |
2905 (while files | 2871 (while files |
2906 (if (and (string-match elisp-source-extention-re (car files)) | 2872 (if (and (string-match emacs-lisp-file-regexp (car files)) |
2907 (not (auto-save-file-name-p (car files))) | 2873 (not (auto-save-file-name-p (car files))) |
2908 (setq source (expand-file-name (car files) | 2874 (setq source (expand-file-name (car files) |
2909 (car command-line-args-left))) | 2875 (car command-line-args-left))) |
2910 (setq dest (byte-compile-dest-file source)) | 2876 (setq dest (byte-compile-dest-file source)) |
2911 (file-exists-p dest) | 2877 (file-exists-p dest) |
2936 (make-obsolete 'dot 'point) | 2902 (make-obsolete 'dot 'point) |
2937 (make-obsolete 'dot-max 'point-max) | 2903 (make-obsolete 'dot-max 'point-max) |
2938 (make-obsolete 'dot-min 'point-min) | 2904 (make-obsolete 'dot-min 'point-min) |
2939 (make-obsolete 'dot-marker 'point-marker) | 2905 (make-obsolete 'dot-marker 'point-marker) |
2940 | 2906 |
2941 (cond ((not (or (and (boundp 'epoch::version) epoch::version) | 2907 (make-obsolete 'buffer-flush-undo 'buffer-disable-undo) |
2942 (string-lessp emacs-version "19"))) | 2908 (make-obsolete 'baud-rate "use the baud-rate variable instead") |
2943 (make-obsolete 'buffer-flush-undo 'buffer-disable-undo) | |
2944 (make-obsolete 'baud-rate "use the baud-rate variable instead") | |
2945 )) | |
2946 | 2909 |
2947 (provide 'byte-compile) | 2910 (provide 'byte-compile) |
2948 | 2911 |
2949 | 2912 |
2950 ;;; report metering (see the hacks in bytecode.c) | 2913 ;;; report metering (see the hacks in bytecode.c) |
2951 | 2914 |
2952 (if (boundp 'byte-code-meter) | 2915 (defun byte-compile-report-ops () |
2953 (defun byte-compile-report-ops () | 2916 (defvar byte-code-meter) |
2954 (defvar byte-code-meter) | 2917 (with-output-to-temp-buffer "*Meter*" |
2955 (with-output-to-temp-buffer "*Meter*" | 2918 (set-buffer "*Meter*") |
2956 (set-buffer "*Meter*") | 2919 (let ((i 0) n op off) |
2957 (let ((i 0) n op off) | 2920 (while (< i 256) |
2958 (while (< i 256) | 2921 (setq n (aref (aref byte-code-meter 0) i) |
2959 (setq n (aref (aref byte-code-meter 0) i) | 2922 off nil) |
2960 off nil) | 2923 (if t ;(not (zerop n)) |
2961 (if t ;(not (zerop n)) | 2924 (progn |
2962 (progn | 2925 (setq op i) |
2963 (setq op i) | 2926 (setq off nil) |
2964 (setq off nil) | 2927 (cond ((< op byte-nth) |
2965 (cond ((< op byte-nth) | 2928 (setq off (logand op 7)) |
2966 (setq off (logand op 7)) | 2929 (setq op (logand op 248))) |
2967 (setq op (logand op 248))) | 2930 ((>= op byte-constant) |
2968 ((>= op byte-constant) | 2931 (setq off (- op byte-constant) |
2969 (setq off (- op byte-constant) | 2932 op byte-constant))) |
2970 op byte-constant))) | 2933 (setq op (aref byte-code-vector op)) |
2971 (setq op (aref byte-code-vector op)) | 2934 (insert (format "%-4d" i)) |
2972 (insert (format "%-4d" i)) | 2935 (insert (symbol-name op)) |
2973 (insert (symbol-name op)) | 2936 (if off (insert " [" (int-to-string off) "]")) |
2974 (if off (insert " [" (int-to-string off) "]")) | 2937 (indent-to 40) |
2975 (indent-to 40) | 2938 (insert (int-to-string n) "\n"))) |
2976 (insert (int-to-string n) "\n"))) | 2939 (setq i (1+ i)))))) |
2977 (setq i (1+ i))))))) | |
2978 | |
2979 | 2940 |
2980 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles | 2941 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles |
2981 ;; itself, compile some of its most used recursive functions (at load time). | 2942 ;; itself, compile some of its most used recursive functions (at load time). |
2982 ;; | 2943 ;; |
2983 (eval-when-compile | 2944 (eval-when-compile |