aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1992-07-15 20:26:37 +0000
committerRichard M. Stallman1992-07-15 20:26:37 +0000
commit52799cb807287a949bcf79ab1254f85529b03ca9 (patch)
treedd86e09ba820a357496047f88e89f0f457a5b3bb
parent83023647e0c1769ad958d0c87618955f04d6b618 (diff)
downloademacs-52799cb807287a949bcf79ab1254f85529b03ca9.tar.gz
emacs-52799cb807287a949bcf79ab1254f85529b03ca9.zip
*** empty log message ***
-rw-r--r--lisp/emacs-lisp/bytecomp.el589
1 files changed, 275 insertions, 314 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1b30194690e..57f83ca57b6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,10 +1,11 @@
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;; Subsequently modified by RMS.
6 7
7(defconst byte-compile-version "2.04; 5-feb-92.") 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
@@ -24,12 +25,13 @@
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
32;;; because they are not terribly useful and get in the way of completion.)
31 33
32;;; This version of the elisp byte compiler has the following improvements: 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
@@ -83,47 +85,27 @@
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:
@@ -153,7 +135,7 @@
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
@@ -161,21 +143,12 @@
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)
169be hard-coded into bytecomp when it compiles itself. If the compiler itself 151(defmacro byte-compile-version-cond (cond) cond)
170is 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)
@@ -183,74 +156,65 @@ is compiled with optimization, this causes a speedup.")
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. 184You may want to redefine `byte-compile-dest-file' if you change this.")
212You 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
243work in generic version 18 emacses without having bytecomp-runtime.el loaded. 213;; (not (or (and (boundp 'epoch::version) epoch::version)
244If this is false, the generated code will be more efficient in emacs 19, and 214;; (string-lessp emacs-version "19")))
245will 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
246See 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
252makes use of byte-ops which are present only in emacs19. Code generated
253this 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.
@@ -275,20 +239,22 @@ of `message.'")
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).
278See doc of macro byte-compiler-options.") 242Valid elements of this list are `callargs', `redefine', `free-vars',
243and `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.
282functions were called and from where. This will be displayed after the 247This records functions were called and from where.
283compilation completes. If it is non-nil, but not t, you will be asked 248If the value is t, compilation displays the call graph when it finishes.
284for whether to display this. 249If the value is neither t nor nil, compilation asks you whether to display
250the graph.
285 251
286The call tree only lists functions called, not macros used. Those functions 252The call tree only lists functions called, not macros used. Those functions
287which the byte-code interpreter knows about directly (eq, cons, etc.) are 253which the byte-code interpreter knows about directly (eq, cons, etc.) are
288not reported. 254not reported.
289 255
290The call tree also lists those functions which are not known to be called 256The 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
292invoked interactively are excluded from this list.") 258invoked 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.
@@ -301,17 +267,17 @@ is a list of functions for which calls were generated while compiling
301FUNCTION.") 267FUNCTION.")
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.
305The values 'name, 'callers, 'calls, 'calls+callers means to sort on 271The values `name', `callers', `calls', `calls+callers'
306the those fields.") 272specify 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
310files will have the same modes as the corresponding .el file. Otherwise, 276;; files will have the same modes as the corresponding .el file. Otherwise,
311existing .elc files will simply be overwritten, and the existing modes 277;; existing .elc files will simply be overwritten, and the existing modes
312will 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
313is 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
314which 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")
@@ -324,8 +290,9 @@ lives partly on the stack.")
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))))))
@@ -337,13 +304,15 @@ Placing a macro here will cause a macro to have different semantics when
337expanded by the compiler as when expanded by the interpreter.") 304expanded 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.
341compiled. It is (MACRONAME . nil) when a macro is redefined as a function.") 308Each 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.
345is being compiled (this is so we can inline them if necessary). It is 313This is so we can inline them when necessary.
346(FUNCTIONNAME . nil) when a function is redefined as a macro.") 314Each 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
@@ -514,25 +483,27 @@ otherwise pop it")
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.
519an 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.
523Takes, on stack, the buffer name. 492;; Binds standard-output and does some other things.
524Binds standard-output and does some other things. 493;; Returns with temp buffer on the stack in place of buffer name.
525Returns 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.
529Expects the temp buffer on the stack underneath value to return. 498;; Pops them both, then pushes the value back on.
530Pops them both, then pushes the value back on. 499;; Unbinds standard-output and makes the temp buffer visible.
531Unbinds 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
535this 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)
@@ -581,7 +552,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
@@ -589,7 +560,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
@@ -636,7 +607,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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)))
@@ -677,8 +648,8 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
@@ -800,61 +771,61 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
@@ -919,8 +890,8 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
@@ -951,9 +922,9 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.")
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
956number 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
@@ -990,10 +961,10 @@ number of arguments."
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
995defined, 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)
@@ -1042,8 +1013,8 @@ defined, issue a warning enumerating them. You can disable this by including
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))
@@ -1083,7 +1054,7 @@ for each such `.el' file, whether to compile it."
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
@@ -1113,18 +1084,11 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
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
@@ -1155,10 +1119,10 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
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))
@@ -1168,10 +1132,11 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
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)
@@ -1182,31 +1147,30 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
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,
1187and 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
1188the 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.
1211Print the result in the minibuffer. 1175Print the result in the minibuffer.
1212With argument, insert value in current buffer after the form." 1176With argument, insert value in current buffer after the form."
@@ -1293,17 +1257,17 @@ With argument, insert value in current buffer after the form."
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
@@ -1486,7 +1450,7 @@ With argument, insert value in current buffer after the form."
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
@@ -1496,7 +1460,7 @@ With argument, insert value in current buffer after the form."
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"
@@ -1589,7 +1553,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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.
@@ -1598,7 +1562,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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))))
@@ -1665,7 +1629,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -1856,7 +1820,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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)
@@ -1971,9 +1935,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2188,7 +2152,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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)))))
@@ -2204,7 +2168,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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)))))
@@ -2285,7 +2249,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2304,7 +2268,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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))
@@ -2372,13 +2336,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2553,7 +2515,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2708,7 +2670,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2735,7 +2697,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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
@@ -2761,19 +2723,22 @@ If FORM is a lambda or a macro, byte-compile it as a function."
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.
2766called them, and what functions they call. This buffer will list all functions 2728(defun display-call-tree (&optional filename)
2767whose definitions have been compiled since this emacs session was started, as 2729 "Display a call graph of a specified file.
2768well as all functions called by those functions. 2730This lists which functions have been called, what functions called
2731them, and what functions they call. The list includes all functions
2732whose definitions have been compiled in this Emacs session, as well as
2733all functions called by those functions.
2769 2734
2770The call tree only lists functions called, not macros or inline functions 2735The call graph does not include macros, inline functions, or
2771expanded. Those functions which the byte-code interpreter knows about directly 2736primitives that the byte-code interpreter knows about directly \(eq,
2772\(eq, cons, etc.\) are not reported. 2737cons, etc.\).
2773 2738
2774The call tree also lists those functions which are not known to be called 2739The 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
2776invoked interactively are excluded from this list." 2741invoked 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*"
@@ -2806,7 +2771,7 @@ invoked interactively are excluded from this list."
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)
@@ -2889,21 +2854,22 @@ invoked interactively are excluded from this list."
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.
2893Must be used only with -batch, and kills emacs on completion. 2858Use this from the command line, with `-batch';
2894Each file will be processed even if an error occurred previously. 2859it won't work in an interactive Emacs.
2860Each file is processed even if an error occurred previously.
2895For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" 2861For 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)))
@@ -2938,44 +2904,39 @@ For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
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).