comparison lisp/bytecomp.el @ 444:576fb035e263 r21-2-37

Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 1ccc32a20af4
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
8 ;; Ben Wing <ben@xemacs.org> 8 ;; Ben Wing <ben@xemacs.org>
9 ;; Martin Buchholz <martin@xemacs.org> 9 ;; Martin Buchholz <martin@xemacs.org>
10 ;; Richard Stallman <rms@gnu.org> 10 ;; Richard Stallman <rms@gnu.org>
11 ;; Keywords: internal lisp 11 ;; Keywords: internal lisp
12 12
13 (defconst byte-compile-version (purecopy "2.27 XEmacs; 2000-09-12.")) 13 (defconst byte-compile-version "2.27 XEmacs; 2000-09-12.")
14 14
15 ;; This file is part of XEmacs. 15 ;; This file is part of XEmacs.
16 16
17 ;; XEmacs is free software; you can redistribute it and/or modify it 17 ;; XEmacs is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by 18 ;; under the terms of the GNU General Public License as published by
119 ;;; symbols) 119 ;;; symbols)
120 ;;; byte-compile-emacs19-compatibility Whether the compiler should 120 ;;; byte-compile-emacs19-compatibility Whether the compiler should
121 ;;; generate .elc files which can be loaded into 121 ;;; generate .elc files which can be loaded into
122 ;;; generic emacs 19. 122 ;;; generic emacs 19.
123 ;;; emacs-lisp-file-regexp Regexp for the extension of source-files; 123 ;;; emacs-lisp-file-regexp Regexp for the extension of source-files;
124 ;;; see also the function byte-compile-dest-file. 124 ;;; see also the function `byte-compile-dest-file'.
125 ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. 125 ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving.
126 ;;; 126 ;;;
127 ;;; Most of the above parameters can also be set on a file-by-file basis; see 127 ;;; Most of the above parameters can also be set on a file-by-file basis; see
128 ;;; the documentation of the `byte-compiler-options' macro. 128 ;;; the documentation of the `byte-compiler-options' macro.
129 129
143 ;;; defined with `defun' by using the `proclaim-inline' form like so: 143 ;;; defined with `defun' by using the `proclaim-inline' form like so:
144 ;;; (proclaim-inline my-function) 144 ;;; (proclaim-inline my-function)
145 ;;; This is, in fact, exactly what `defsubst' does. To make a function no 145 ;;; This is, in fact, exactly what `defsubst' does. To make a function no
146 ;;; longer be inline, you must use `proclaim-notinline'. Beware that if 146 ;;; longer be inline, you must use `proclaim-notinline'. Beware that if
147 ;;; you define a function with `defsubst' and later redefine it with 147 ;;; you define a function with `defsubst' and later redefine it with
148 ;;; `defun', it will still be open-coded until you use proclaim-notinline. 148 ;;; `defun', it will still be open-coded until you use `proclaim-notinline'.
149 ;;; 149 ;;;
150 ;;; o You can also open-code one particular call to a function without 150 ;;; o You can also open-code one particular call to a function without
151 ;;; open-coding all calls. Use the 'inline' form to do this, like so: 151 ;;; open-coding all calls. Use the 'inline' form to do this, like so:
152 ;;; 152 ;;;
153 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded 153 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded
162 ;;; the compilation environment in the same way that it remembers macro 162 ;;; the compilation environment in the same way that it remembers macro
163 ;;; definitions. 163 ;;; definitions.
164 ;;; 164 ;;;
165 ;;; o Forms like ((lambda ...) ...) are open-coded. 165 ;;; o Forms like ((lambda ...) ...) are open-coded.
166 ;;; 166 ;;;
167 ;;; o The form `eval-when-compile' is like progn, except that the body 167 ;;; o The form `eval-when-compile' is like `progn', except that the body
168 ;;; is evaluated at compile-time. When it appears at top-level, this 168 ;;; is evaluated at compile-time. When it appears at top-level, this
169 ;;; is analogous to the Common Lisp idiom (eval-when (compile) ...). 169 ;;; is analogous to the Common Lisp idiom (eval-when (compile) ...).
170 ;;; When it does not appear at top-level, it is similar to the 170 ;;; When it does not appear at top-level, it is similar to the
171 ;;; Common Lisp #. reader macro (but not in interpreted code). 171 ;;; Common Lisp #. reader macro (but not in interpreted code).
172 ;;; 172 ;;;
173 ;;; o The form `eval-and-compile' is similar to eval-when-compile, but 173 ;;; o The form `eval-and-compile' is similar to `eval-when-compile',
174 ;;; the whole form is evalled both at compile-time and at run-time. 174 ;;; but the whole form is evalled both at compile-time and at run-time.
175 ;;; 175 ;;;
176 ;;; o The command M-x byte-compile-and-load-file does what you'd think. 176 ;;; o The command M-x byte-compile-and-load-file does what you'd think.
177 ;;; 177 ;;;
178 ;;; o The command compile-defun is analogous to eval-defun. 178 ;;; o The command `compile-defun' is analogous to `eval-defun'.
179 ;;; 179 ;;;
180 ;;; o If you run byte-compile-file on a filename which is visited in a 180 ;;; o If you run `byte-compile-file' on a filename which is visited in a
181 ;;; buffer, and that buffer is modified, you are asked whether you want 181 ;;; buffer, and that buffer is modified, you are asked whether you want
182 ;;; to save the buffer before compiling. 182 ;;; to save the buffer before compiling.
183 ;;; 183 ;;;
184 ;;; o You can add this to /etc/magic to make file(1) recognize the files 184 ;;; o You can add this to /etc/magic to make file(1) recognize the files
185 ;;; generated by this compiler: 185 ;;; generated by this compiler:
227 (t 227 (t
228 (defmacro byte-compile-single-version () nil) 228 (defmacro byte-compile-single-version () nil)
229 (defmacro byte-compile-version-cond (cond) cond))) 229 (defmacro byte-compile-version-cond (cond) cond)))
230 ) 230 )
231 231
232 (defvar emacs-lisp-file-regexp (purecopy "\\.el$") 232 (defvar emacs-lisp-file-regexp "\\.el$"
233 "*Regexp which matches Emacs Lisp source files. 233 "*Regexp which matches Emacs Lisp source files.
234 You may want to redefine `byte-compile-dest-file' if you change this.") 234 You may want to redefine `byte-compile-dest-file' if you change this.")
235 235
236 ;; This enables file name handlers such as jka-compr 236 ;; This enables file name handlers such as jka-compr
237 ;; to remove parts of the file name that should not be copied 237 ;; to remove parts of the file name that should not be copied
442 (defvar byte-compile-free-assignments) 442 (defvar byte-compile-free-assignments)
443 443
444 (defvar byte-compiler-error-flag) 444 (defvar byte-compiler-error-flag)
445 445
446 (defconst byte-compile-initial-macro-environment 446 (defconst byte-compile-initial-macro-environment
447 (purecopy 447 '((byte-compiler-options . (lambda (&rest forms)
448 '((byte-compiler-options . (lambda (&rest forms) 448 (apply 'byte-compiler-options-handler forms)))
449 (apply 'byte-compiler-options-handler forms))) 449 (eval-when-compile . (lambda (&rest body)
450 (eval-when-compile . (lambda (&rest body) 450 (list 'quote (eval (cons 'progn body)))))
451 (list 'quote (eval (byte-compile-top-level 451 (eval-and-compile . (lambda (&rest body)
452 (cons 'progn body)))))) 452 (eval (cons 'progn body))
453 (eval-and-compile . (lambda (&rest body) 453 (cons 'progn body))))
454 (eval (cons 'progn body))
455 (cons 'progn body)))))
456 "The default macro-environment passed to macroexpand by the compiler. 454 "The default macro-environment passed to macroexpand by the compiler.
457 Placing a macro here will cause a macro to have different semantics when 455 Placing a macro here will cause a macro to have different semantics when
458 expanded by the compiler as when expanded by the interpreter.") 456 expanded by the compiler as when expanded by the interpreter.")
459 457
460 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment 458 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment
714 (byte-defop 192 1 byte-constant "for reference to a constant") 712 (byte-defop 192 1 byte-constant "for reference to a constant")
715 ;; codes 193-255 are consumed by byte-constant. 713 ;; codes 193-255 are consumed by byte-constant.
716 (defconst byte-constant-limit 64 714 (defconst byte-constant-limit 64
717 "Exclusive maximum index usable in the `byte-constant' opcode.") 715 "Exclusive maximum index usable in the `byte-constant' opcode.")
718 716
719 (defconst byte-goto-ops (purecopy 717 (defconst byte-goto-ops
720 '(byte-goto byte-goto-if-nil byte-goto-if-not-nil 718 '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
721 byte-goto-if-nil-else-pop 719 byte-goto-if-nil-else-pop
722 byte-goto-if-not-nil-else-pop)) 720 byte-goto-if-not-nil-else-pop)
723 "List of byte-codes whose offset is a pc.") 721 "List of byte-codes whose offset is a pc.")
724 722
725 (defconst byte-goto-always-pop-ops 723 (defconst byte-goto-always-pop-ops
726 (purecopy '(byte-goto-if-nil byte-goto-if-not-nil))) 724 '(byte-goto-if-nil byte-goto-if-not-nil))
727 725
728 (defconst byte-rel-goto-ops 726 (defconst byte-rel-goto-ops
729 (purecopy '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil 727 '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil
730 byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop)) 728 byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop)
731 "byte-codes for relative jumps.") 729 "byte-codes for relative jumps.")
732 730
733 (byte-extrude-byte-code-vectors) 731 (byte-extrude-byte-code-vectors)
734 732
735 ;;; lapcode generator 733 ;;; lapcode generator
995 (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options))) 993 (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
996 (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 994 (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
997 '(emacs19) '(emacs20))))) 995 '(emacs19) '(emacs20)))))
998 996
999 ;; now we can copy it. 997 ;; now we can copy it.
1000 (setq byte-compiler-legal-options (purecopy byte-compiler-legal-options)) 998 (setq byte-compiler-legal-options byte-compiler-legal-options)
1001 999
1002 (defun byte-compiler-options-handler (&rest args) 1000 (defun byte-compiler-options-handler (&rest args)
1003 (let (key val desc choices) 1001 (let (key val desc choices)
1004 (while args 1002 (while args
1005 (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) 1003 (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
1227 (not (= 0 (logand (cdr (car rest)) 1225 (not (= 0 (logand (cdr (car rest))
1228 byte-compile-global-bit)))) 1226 byte-compile-global-bit))))
1229 (setq var nil)) 1227 (setq var nil))
1230 (setq rest (cdr rest))) 1228 (setq rest (cdr rest)))
1231 ;; if var is nil at this point, it's a defvar in this file. 1229 ;; if var is nil at this point, it's a defvar in this file.
1232 (not var)))) 1230 (not var))
1231 ;; Perhaps (eval-when-compile (defvar foo))
1232 (and (boundp 'current-load-list)
1233 (memq var current-load-list))))
1233 1234
1234 1235
1235 ;;; If we have compiled bindings of variables which have no referents, warn. 1236 ;;; If we have compiled bindings of variables which have no referents, warn.
1236 (defun byte-compile-warn-about-unused-variables () 1237 (defun byte-compile-warn-about-unused-variables ()
1237 (let ((rest byte-compile-bound-variables) 1238 (let ((rest byte-compile-bound-variables)
1369 1370
1370 ;;;###autoload 1371 ;;;###autoload
1371 (defun byte-recompile-directory (directory &optional arg norecursion force) 1372 (defun byte-recompile-directory (directory &optional arg norecursion force)
1372 "Recompile every `.el' file in DIRECTORY that needs recompilation. 1373 "Recompile every `.el' file in DIRECTORY that needs recompilation.
1373 This is if a `.elc' file exists but is older than the `.el' file. 1374 This is if a `.elc' file exists but is older than the `.el' file.
1374 Files in subdirectories of DIRECTORY are processed also unless argument 1375 Files in subdirectories of DIRECTORY are also processed unless
1375 NORECURSION is non-nil. 1376 optional argument NORECURSION is non-nil.
1376 1377
1377 If the `.elc' file does not exist, normally the `.el' file is *not* compiled. 1378 If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
1378 But a prefix argument (optional second arg) means ask user, 1379 But a prefix argument (optional second arg) means ask user,
1379 for each such `.el' file, whether to compile it. Prefix argument 0 means 1380 for each such `.el' file, whether to compile it. Prefix argument 0 means
1380 don't ask and compile the file anyway. 1381 don't ask and compile the file anyway.
1381 1382
1382 A nonzero prefix argument also means ask about each subdirectory. 1383 A nonzero prefix argument also means ask about each subdirectory.
1383 1384
1384 If the fourth argument FORCE is non-nil, 1385 If the fourth optional argument FORCE is non-nil,
1385 recompile every `.el' file that already has a `.elc' file." 1386 recompile every `.el' file that already has a `.elc' file."
1386 (interactive "DByte recompile directory: \nP") 1387 (interactive "DByte recompile directory: \nP")
1387 (if arg 1388 (if arg
1388 (setq arg (prefix-numeric-value arg))) 1389 (setq arg (prefix-numeric-value arg)))
1389 (if noninteractive 1390 (if noninteractive
2677 (if cell (setcdr cell 2678 (if cell (setcdr cell
2678 (logior (cdr cell) 2679 (logior (cdr cell)
2679 (if (eq base-op 'byte-varset) 2680 (if (eq base-op 'byte-varset)
2680 byte-compile-assigned-bit 2681 byte-compile-assigned-bit
2681 byte-compile-referenced-bit))))) 2682 byte-compile-referenced-bit)))))
2683 (and (boundp 'current-load-list)
2684 (memq var current-load-list))
2682 (if (eq base-op 'byte-varset) 2685 (if (eq base-op 'byte-varset)
2683 (or (memq var byte-compile-free-assignments) 2686 (or (memq var byte-compile-free-assignments)
2684 (progn 2687 (progn
2685 (byte-compile-warn "assignment to free variable %s" 2688 (byte-compile-warn "assignment to free variable %s"
2686 var) 2689 var)
3767 (when (memq 'free-vars byte-compile-warnings) 3770 (when (memq 'free-vars byte-compile-warnings)
3768 (push (cons var byte-compile-global-bit) byte-compile-bound-variables)) 3771 (push (cons var byte-compile-global-bit) byte-compile-bound-variables))
3769 (byte-compile-body-do-effect 3772 (byte-compile-body-do-effect
3770 (list 3773 (list
3771 ;; Put the defined variable in this library's load-history entry 3774 ;; Put the defined variable in this library's load-history entry
3772 ;; just as a real defvar would, but only in top-level forms. 3775 ;; just as a real defvar would, but only in top-level forms with values.
3773 (when (null byte-compile-current-form) 3776 (when (and (> (length form) 2)
3777 (null byte-compile-current-form))
3774 `(push ',var current-load-list)) 3778 `(push ',var current-load-list))
3775 (when (> (length form) 3) 3779 (when (> (length form) 3)
3776 (when (and string (not (stringp string))) 3780 (when (and string (not (stringp string)))
3777 (byte-compile-warn "Third arg to %s %s is not a string: %s" 3781 (byte-compile-warn "Third arg to %s %s is not a string: %s"
3778 fun var string)) 3782 fun var string))
4046 (defun batch-byte-compile () 4050 (defun batch-byte-compile ()
4047 "Run `byte-compile-file' on the files remaining on the command line. 4051 "Run `byte-compile-file' on the files remaining on the command line.
4048 Use this from the command line, with `-batch'; 4052 Use this from the command line, with `-batch';
4049 it won't work in an interactive Emacs. 4053 it won't work in an interactive Emacs.
4050 Each file is processed even if an error occurred previously. 4054 Each file is processed even if an error occurred previously.
4051 For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" 4055 For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"."
4052 ;; command-line-args-left is what is left of the command line (from 4056 ;; command-line-args-left is what is left of the command line (from
4053 ;; startup.el) 4057 ;; startup.el)
4054 (defvar command-line-args-left) ;Avoid 'free variable' warning 4058 (defvar command-line-args-left) ;Avoid 'free variable' warning
4055 (if (not noninteractive) 4059 (if (not noninteractive)
4056 (error "`batch-byte-compile' is to be used only with -batch")) 4060 (error "`batch-byte-compile' is to be used only with -batch"))