Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 11cf20601dec
children 7df0dd720c89
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 ;; General Public License for more details. 24 ;; General Public License for more details.
25 25
26 ;; You should have received a copy of the GNU General Public License 26 ;; You should have received a copy of the GNU General Public License
27 ;; along with XEmacs; see the file COPYING. If not, write to the 27 ;; along with XEmacs; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 ;; Boston, MA 02111-1307, USA. 29 ;; Boston, MA 02111-1307, USA.
30 30
31 ;;; Synched up with: FSF 19.30. 31 ;;; Synched up with: FSF 19.30.
32 32
64 ;;; + compile-time warning messages for: 64 ;;; + compile-time warning messages for:
65 ;;; - functions being redefined with incompatible arglists; 65 ;;; - functions being redefined with incompatible arglists;
66 ;;; - functions being redefined as macros, or vice-versa; 66 ;;; - functions being redefined as macros, or vice-versa;
67 ;;; - functions or macros defined multiple times in the same file; 67 ;;; - functions or macros defined multiple times in the same file;
68 ;;; - functions being called with the incorrect number of arguments; 68 ;;; - functions being called with the incorrect number of arguments;
69 ;;; - functions being called which are not defined globally, in the 69 ;;; - functions being called which are not defined globally, in the
70 ;;; file, or as autoloads; 70 ;;; file, or as autoloads;
71 ;;; - assignment and reference of undeclared free variables; 71 ;;; - assignment and reference of undeclared free variables;
72 ;;; - various syntax errors; 72 ;;; - various syntax errors;
73 ;;; + correct compilation of nested defuns, defmacros, defvars and defsubsts; 73 ;;; + correct compilation of nested defuns, defmacros, defvars and defsubsts;
74 ;;; + correct compilation of top-level uses of macros; 74 ;;; + correct compilation of top-level uses of macros;
76 76
77 ;;; User customization variables: 77 ;;; User customization variables:
78 ;;; 78 ;;;
79 ;;; byte-compile-verbose Whether to report the function currently being 79 ;;; byte-compile-verbose Whether to report the function currently being
80 ;;; compiled in the minibuffer; 80 ;;; compiled in the minibuffer;
81 ;;; byte-optimize Whether to do optimizations; this may be 81 ;;; byte-optimize Whether to do optimizations; this may be
82 ;;; t, nil, 'source, or 'byte; 82 ;;; t, nil, 'source, or 'byte;
83 ;;; byte-optimize-log Whether to report (in excruciating detail) 83 ;;; byte-optimize-log Whether to report (in excruciating detail)
84 ;;; exactly which optimizations have been made. 84 ;;; exactly which optimizations have been made.
85 ;;; This may be t, nil, 'source, or 'byte; 85 ;;; This may be t, nil, 'source, or 'byte;
86 ;;; byte-compile-error-on-warn Whether to stop compilation when a warning is 86 ;;; byte-compile-error-on-warn Whether to stop compilation when a warning is
87 ;;; produced; 87 ;;; produced;
88 ;;; byte-compile-delete-errors Whether the optimizer may delete calls or 88 ;;; byte-compile-delete-errors Whether the optimizer may delete calls or
89 ;;; variable references that are side-effect-free 89 ;;; variable references that are side-effect-free
90 ;;; except that they may return an error. 90 ;;; except that they may return an error.
91 ;;; byte-compile-generate-call-tree Whether to generate a histogram of 91 ;;; byte-compile-generate-call-tree Whether to generate a histogram of
92 ;;; function calls. This can be useful for 92 ;;; function calls. This can be useful for
93 ;;; finding unused functions, as well as simple 93 ;;; finding unused functions, as well as simple
94 ;;; performance metering. 94 ;;; performance metering.
95 ;;; byte-compile-warnings List of warnings to issue, or t. May contain 95 ;;; byte-compile-warnings List of warnings to issue, or t. May contain
96 ;;; 'free-vars (references to variables not in the 96 ;;; 'free-vars (references to variables not in the
97 ;;; current lexical scope) 97 ;;; current lexical scope)
131 ;;; o You can make a given function be inline even if it has already been 131 ;;; o You can make a given function be inline even if it has already been
132 ;;; defined with `defun' by using the `proclaim-inline' form like so: 132 ;;; defined with `defun' by using the `proclaim-inline' form like so:
133 ;;; (proclaim-inline my-function) 133 ;;; (proclaim-inline my-function)
134 ;;; This is, in fact, exactly what `defsubst' does. To make a function no 134 ;;; This is, in fact, exactly what `defsubst' does. To make a function no
135 ;;; longer be inline, you must use `proclaim-notinline'. Beware that if 135 ;;; longer be inline, you must use `proclaim-notinline'. Beware that if
136 ;;; you define a function with `defsubst' and later redefine it with 136 ;;; you define a function with `defsubst' and later redefine it with
137 ;;; `defun', it will still be open-coded until you use proclaim-notinline. 137 ;;; `defun', it will still be open-coded until you use proclaim-notinline.
138 ;;; 138 ;;;
139 ;;; o You can also open-code one particular call to a function without 139 ;;; o You can also open-code one particular call to a function without
140 ;;; open-coding all calls. Use the 'inline' form to do this, like so: 140 ;;; open-coding all calls. Use the 'inline' form to do this, like so:
141 ;;; 141 ;;;
142 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded 142 ;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded
143 ;;; or... 143 ;;; or...
144 ;;; (inline ;; `foo' and `baz' will be 144 ;;; (inline ;; `foo' and `baz' will be
145 ;;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not. 145 ;;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not.
146 ;;; (baz 0)) 146 ;;; (baz 0))
147 ;;; 147 ;;;
148 ;;; o It is possible to open-code a function in the same file it is defined 148 ;;; o It is possible to open-code a function in the same file it is defined
149 ;;; in without having to load that file before compiling it. the 149 ;;; in without having to load that file before compiling it. the
164 ;;; 164 ;;;
165 ;;; o The command M-x byte-compile-and-load-file does what you'd think. 165 ;;; o The command M-x byte-compile-and-load-file does what you'd think.
166 ;;; 166 ;;;
167 ;;; o The command compile-defun is analogous to eval-defun. 167 ;;; o The command compile-defun is analogous to eval-defun.
168 ;;; 168 ;;;
169 ;;; o If you run byte-compile-file on a filename which is visited in a 169 ;;; o If you run byte-compile-file on a filename which is visited in a
170 ;;; buffer, and that buffer is modified, you are asked whether you want 170 ;;; buffer, and that buffer is modified, you are asked whether you want
171 ;;; to save the buffer before compiling. 171 ;;; to save the buffer before compiling.
172 ;;; 172 ;;;
173 ;;; o You can add this to /etc/magic to make file(1) recognise the files 173 ;;; o You can add this to /etc/magic to make file(1) recognise the files
174 ;;; generated by this compiler: 174 ;;; generated by this compiler:
267 267
268 (defvar byte-compile-emacs19-compatibility 268 (defvar byte-compile-emacs19-compatibility
269 (not (emacs-version>= 20)) 269 (not (emacs-version>= 20))
270 "*Non-nil means generate output that can run in Emacs 19.") 270 "*Non-nil means generate output that can run in Emacs 19.")
271 271
272 (defvar byte-compile-print-gensym t
273 "*Non-nil means generate code that creates unique symbols at run-time.
274 This is achieved by printing uninterned symbols using the `#:SYMBOL'
275 notation, so that they will be read uninterned when run.
276
277 With this feature, code that uses uninterned symbols in macros will
278 not be runnable under pre-21.0 XEmacsen.
279
280 When `byte-compile-emacs19-compatibility' is non-nil, this variable is
281 ignored and considered to be nil.")
282
272 (defvar byte-optimize t 283 (defvar byte-optimize t
273 "*Enables optimization in the byte compiler. 284 "*Enables optimization in the byte compiler.
274 nil means don't do any optimization. 285 nil means don't do any optimization.
275 t means do all optimizations. 286 t means do all optimizations.
276 `source' means do source-level optimizations only. 287 `source' means do source-level optimizations only.
390 401
391 (defvar byte-compile-overwrite-file t 402 (defvar byte-compile-overwrite-file t
392 "If nil, old .elc files are deleted before the new is saved, and .elc 403 "If nil, old .elc files are deleted before the new is saved, and .elc
393 files will have the same modes as the corresponding .el file. Otherwise, 404 files will have the same modes as the corresponding .el file. Otherwise,
394 existing .elc files will simply be overwritten, and the existing modes 405 existing .elc files will simply be overwritten, and the existing modes
395 will not be changed. If this variable is nil, then an .elc file which 406 will not be changed. If this variable is nil, then an .elc file which
396 is a symbolic link will be turned into a normal file, instead of the file 407 is a symbolic link will be turned into a normal file, instead of the file
397 which the link points to being overwritten.") 408 which the link points to being overwritten.")
398 409
399 (defvar byte-recompile-directory-ignore-errors-p nil 410 (defvar byte-recompile-directory-ignore-errors-p nil
400 "If true, then `byte-recompile-directory' will continue compiling even 411 "If true, then `byte-recompile-directory' will continue compiling even
408 "list of all constants encountered during compilation of this form") 419 "list of all constants encountered during compilation of this form")
409 (defvar byte-compile-variables nil 420 (defvar byte-compile-variables nil
410 "list of all variables encountered during compilation of this form") 421 "list of all variables encountered during compilation of this form")
411 (defvar byte-compile-bound-variables nil 422 (defvar byte-compile-bound-variables nil
412 "Alist of variables bound in the context of the current form, 423 "Alist of variables bound in the context of the current form,
413 that is, the current lexical environment. This list lives partly 424 that is, the current lexical environment. This list lives partly
414 on the specbind stack. The cdr of each cell is an integer bitmask.") 425 on the specbind stack. The cdr of each cell is an integer bitmask.")
415 426
416 (defconst byte-compile-referenced-bit 1) 427 (defconst byte-compile-referenced-bit 1)
417 (defconst byte-compile-assigned-bit 2) 428 (defconst byte-compile-assigned-bit 2)
418 (defconst byte-compile-arglist-bit 4) 429 (defconst byte-compile-arglist-bit 4)
603 (byte-defop 130 0 byte-goto "for unconditional jump") 614 (byte-defop 130 0 byte-goto "for unconditional jump")
604 (byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil") 615 (byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
605 (byte-defop 132 -1 byte-goto-if-not-nil 616 (byte-defop 132 -1 byte-goto-if-not-nil
606 "to pop value and jump if it's not nil") 617 "to pop value and jump if it's not nil")
607 (byte-defop 133 -1 byte-goto-if-nil-else-pop 618 (byte-defop 133 -1 byte-goto-if-nil-else-pop
608 "to examine top-of-stack, jump and don't pop it if it's nil, 619 "to examine top-of-stack, jump and don't pop it if it's nil,
609 otherwise pop it") 620 otherwise pop it")
610 (byte-defop 134 -1 byte-goto-if-not-nil-else-pop 621 (byte-defop 134 -1 byte-goto-if-not-nil-else-pop
611 "to examine top-of-stack, jump and don't pop it if it's non nil, 622 "to examine top-of-stack, jump and don't pop it if it's non nil,
612 otherwise pop it") 623 otherwise pop it")
613 624
614 (byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'") 625 (byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
615 (byte-defop 136 -1 byte-discard "to discard one value from stack") 626 (byte-defop 136 -1 byte-discard "to discard one value from stack")
616 (byte-defop 137 1 byte-dup "to duplicate the top of the stack") 627 (byte-defop 137 1 byte-dup "to duplicate the top of the stack")
624 (byte-defop 141 -1 byte-catch 635 (byte-defop 141 -1 byte-catch
625 "for catch. Takes, on stack, the tag and an expression for the body") 636 "for catch. Takes, on stack, the tag and an expression for the body")
626 (byte-defop 142 -1 byte-unwind-protect 637 (byte-defop 142 -1 byte-unwind-protect
627 "for unwind-protect. Takes, on stack, an expression for the unwind-action") 638 "for unwind-protect. Takes, on stack, an expression for the unwind-action")
628 639
629 ;; For condition-case. Takes, on stack, the variable to bind, 640 ;; For condition-case. Takes, on stack, the variable to bind,
630 ;; an expression for the body, and a list of clauses. 641 ;; an expression for the body, and a list of clauses.
631 (byte-defop 143 -2 byte-condition-case) 642 (byte-defop 143 -2 byte-condition-case)
632 643
633 ;; For entry to with-output-to-temp-buffer. 644 ;; For entry to with-output-to-temp-buffer.
634 ;; Takes, on stack, the buffer name. 645 ;; Takes, on stack, the buffer name.
720 ;;; 731 ;;;
721 ;;; Elements of the lapcode list are of the form (<instruction> . <parameter>) 732 ;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
722 ;;; where instruction is a symbol naming a byte-code instruction, 733 ;;; where instruction is a symbol naming a byte-code instruction,
723 ;;; and parameter is an argument to that instruction, if any. 734 ;;; and parameter is an argument to that instruction, if any.
724 ;;; 735 ;;;
725 ;;; The instruction can be the pseudo-op TAG, which means that this position 736 ;;; The instruction can be the pseudo-op TAG, which means that this position
726 ;;; in the instruction stream is a target of a goto. (car PARAMETER) will be 737 ;;; in the instruction stream is a target of a goto. (car PARAMETER) will be
727 ;;; the PC for this location, and the whole instruction "(TAG pc)" will be the 738 ;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
728 ;;; parameter for some goto op. 739 ;;; parameter for some goto op.
729 ;;; 740 ;;;
730 ;;; If the operation is varbind, varref, varset or push-constant, then the 741 ;;; If the operation is varbind, varref, varset or push-constant, then the
981 ;; XEmacs addition 992 ;; XEmacs addition
982 (defconst byte-compiler-obsolete-options 993 (defconst byte-compiler-obsolete-options
983 '((new-bytecodes t))) 994 '((new-bytecodes t)))
984 995
985 ;; Inhibit v19/v20 selectors if the version is hardcoded. 996 ;; Inhibit v19/v20 selectors if the version is hardcoded.
986 ;; #### This should print a warning if the user tries to change something 997 ;; #### This should print a warning if the user tries to change something
987 ;; than can't be changed because the running compiler doesn't support it. 998 ;; than can't be changed because the running compiler doesn't support it.
988 (cond 999 (cond
989 ((byte-compile-single-version) 1000 ((byte-compile-single-version)
990 (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options))) 1001 (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
991 (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 1002 (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
1171 "%s being defined to take %s%s, but was previously called with %s" 1182 "%s being defined to take %s%s, but was previously called with %s"
1172 (nth 1 form) 1183 (nth 1 form)
1173 (byte-compile-arglist-signature-string sig) 1184 (byte-compile-arglist-signature-string sig)
1174 (if (equal sig '(1 . 1)) " arg" " args") 1185 (if (equal sig '(1 . 1)) " arg" " args")
1175 (byte-compile-arglist-signature-string (cons min max)))) 1186 (byte-compile-arglist-signature-string (cons min max))))
1176 1187
1177 (setq byte-compile-unresolved-functions 1188 (setq byte-compile-unresolved-functions
1178 (delq calls byte-compile-unresolved-functions))))) 1189 (delq calls byte-compile-unresolved-functions)))))
1179 ))) 1190 )))
1180 1191
1181 ;; If we have compiled any calls to functions which are not known to be 1192 ;; If we have compiled any calls to functions which are not known to be
1182 ;; defined, issue a warning enumerating them. 1193 ;; defined, issue a warning enumerating them.
1183 ;; `unresolved' in the list `byte-compile-warnings' disables this. 1194 ;; `unresolved' in the list `byte-compile-warnings' disables this.
1184 (defun byte-compile-warn-about-unresolved-functions (&optional msg) 1195 (defun byte-compile-warn-about-unresolved-functions (&optional msg)
1185 (if (memq 'unresolved byte-compile-warnings) 1196 (if (memq 'unresolved byte-compile-warnings)
1186 (let ((byte-compile-current-form (or msg "the end of the data"))) 1197 (let ((byte-compile-current-form (or msg "the end of the data")))
1269 ((not (symbolp (, form)))) 1280 ((not (symbolp (, form))))
1270 ((keywordp (, form))) 1281 ((keywordp (, form)))
1271 ((memq (, form) '(nil t)))))) 1282 ((memq (, form) '(nil t))))))
1272 1283
1273 (defmacro byte-compile-close-variables (&rest body) 1284 (defmacro byte-compile-close-variables (&rest body)
1274 (cons 'let 1285 `(let
1275 (cons '(;; 1286 (;;
1276 ;; Close over these variables to encapsulate the 1287 ;; Close over these variables to encapsulate the
1277 ;; compilation state 1288 ;; compilation state
1278 ;; 1289 ;;
1279 (byte-compile-macro-environment 1290 (byte-compile-macro-environment
1280 ;; Copy it because the compiler may patch into the 1291 ;; Copy it because the compiler may patch into the
1281 ;; macroenvironment. 1292 ;; macroenvironment.
1282 (copy-alist byte-compile-initial-macro-environment)) 1293 (copy-alist byte-compile-initial-macro-environment))
1283 (byte-compile-function-environment nil) 1294 (byte-compile-function-environment nil)
1284 (byte-compile-autoload-environment nil) 1295 (byte-compile-autoload-environment nil)
1285 (byte-compile-unresolved-functions nil) 1296 (byte-compile-unresolved-functions nil)
1286 (byte-compile-bound-variables nil) 1297 (byte-compile-bound-variables nil)
1287 (byte-compile-free-references nil) 1298 (byte-compile-free-references nil)
1288 (byte-compile-free-assignments nil) 1299 (byte-compile-free-assignments nil)
1289 ;; 1300 ;;
1290 ;; Close over these variables so that `byte-compiler-options' 1301 ;; Close over these variables so that `byte-compiler-options'
1291 ;; can change them on a per-file basis. 1302 ;; can change them on a per-file basis.
1292 ;; 1303 ;;
1293 (byte-compile-verbose byte-compile-verbose) 1304 (byte-compile-verbose byte-compile-verbose)
1294 (byte-optimize byte-optimize) 1305 (byte-optimize byte-optimize)
1295 (byte-compile-emacs19-compatibility 1306 (byte-compile-emacs19-compatibility
1296 byte-compile-emacs19-compatibility) 1307 byte-compile-emacs19-compatibility)
1297 (byte-compile-dynamic byte-compile-dynamic) 1308 (byte-compile-dynamic byte-compile-dynamic)
1298 (byte-compile-dynamic-docstrings 1309 (byte-compile-dynamic-docstrings
1299 byte-compile-dynamic-docstrings) 1310 byte-compile-dynamic-docstrings)
1300 (byte-compile-warnings (if (eq byte-compile-warnings t) 1311 (byte-compile-warnings (if (eq byte-compile-warnings t)
1301 byte-compile-default-warnings 1312 byte-compile-default-warnings
1302 byte-compile-warnings)) 1313 byte-compile-warnings))
1303 (byte-compile-file-domain nil) 1314 (byte-compile-file-domain nil)
1304 ) 1315 )
1305 (list 1316 (prog1
1306 (list 'prog1 (cons 'progn body) 1317 (progn ,@body)
1307 '(if (memq 'unused-vars byte-compile-warnings) 1318 (if (memq 'unused-vars byte-compile-warnings)
1308 ;; done compiling in this scope, warn now. 1319 ;; done compiling in this scope, warn now.
1309 (byte-compile-warn-about-unused-variables))))))) 1320 (byte-compile-warn-about-unused-variables)))))
1310 1321
1311 1322
1312 (defvar byte-compile-warnings-point-max nil) 1323 (defvar byte-compile-warnings-point-max nil)
1313 (defmacro displaying-byte-compile-warnings (&rest body) 1324 (defmacro displaying-byte-compile-warnings (&rest body)
1314 (list 'let 1325 `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
1315 '((byte-compile-warnings-point-max byte-compile-warnings-point-max))
1316 ;; Log the file name. 1326 ;; Log the file name.
1317 '(byte-compile-log-file) 1327 (byte-compile-log-file)
1318 ;; Record how much is logged now. 1328 ;; Record how much is logged now.
1319 ;; We will display the log buffer if anything more is logged 1329 ;; We will display the log buffer if anything more is logged
1320 ;; before the end of BODY. 1330 ;; before the end of BODY.
1321 '(or byte-compile-warnings-point-max 1331 (or byte-compile-warnings-point-max
1322 (save-excursion 1332 (save-excursion
1323 (set-buffer (get-buffer-create "*Compile-Log*")) 1333 (set-buffer (get-buffer-create "*Compile-Log*"))
1324 (setq byte-compile-warnings-point-max (point-max)))) 1334 (setq byte-compile-warnings-point-max (point-max))))
1325 (list 'unwind-protect 1335 (unwind-protect
1326 (list 'condition-case 'error-info 1336 (condition-case error-info
1327 (cons 'progn body) 1337 (progn ,@body)
1328 '(error 1338 (error
1329 (byte-compile-report-error error-info))) 1339 (byte-compile-report-error error-info)))
1330 '(save-excursion 1340 (save-excursion
1331 ;; If there were compilation warnings, display them. 1341 ;; If there were compilation warnings, display them.
1332 (set-buffer "*Compile-Log*") 1342 (set-buffer "*Compile-Log*")
1333 (if (= byte-compile-warnings-point-max (point-max)) 1343 (if (= byte-compile-warnings-point-max (point-max))
1334 nil 1344 nil
1335 (if temp-buffer-show-function 1345 (if temp-buffer-show-function
1336 (let ((show-buffer (get-buffer-create "*Compile-Log-Show*"))) 1346 (let ((show-buffer (get-buffer-create "*Compile-Log-Show*")))
1337 (save-excursion 1347 (save-excursion
1338 (set-buffer show-buffer) 1348 (set-buffer show-buffer)
1339 (setq buffer-read-only nil) 1349 (setq buffer-read-only nil)
1340 (erase-buffer)) 1350 (erase-buffer))
1341 (copy-to-buffer show-buffer 1351 (copy-to-buffer show-buffer
1342 (save-excursion 1352 (save-excursion
1343 (goto-char byte-compile-warnings-point-max) 1353 (goto-char byte-compile-warnings-point-max)
1344 (forward-line -1) 1354 (forward-line -1)
1345 (point)) 1355 (point))
1346 (point-max)) 1356 (point-max))
1347 (funcall temp-buffer-show-function show-buffer)) 1357 (funcall temp-buffer-show-function show-buffer))
1348 (select-window 1358 (select-window
1349 (prog1 (selected-window) 1359 (prog1 (selected-window)
1350 (select-window (display-buffer (current-buffer))) 1360 (select-window (display-buffer (current-buffer)))
1351 (goto-char byte-compile-warnings-point-max) 1361 (goto-char byte-compile-warnings-point-max)
1352 (recenter 1))))))))) 1362 (recenter 1)))))))))
1451 (if (file-exists-p dest) 1461 (if (file-exists-p dest)
1452 (file-newer-than-file-p filename dest) 1462 (file-newer-than-file-p filename dest)
1453 (and force 1463 (and force
1454 (or (eq 0 force) 1464 (or (eq 0 force)
1455 (y-or-n-p (concat "Compile " filename "? ")))))) 1465 (y-or-n-p (concat "Compile " filename "? "))))))
1456 (byte-compile-file filename)))) 1466 (byte-compile-file filename))))
1457 1467
1458 (defvar kanji-flag nil) 1468 (defvar kanji-flag nil)
1459 1469
1460 ;;;###autoload 1470 ;;;###autoload
1461 (defun byte-compile-file (filename &optional load) 1471 (defun byte-compile-file (filename &optional load)
1556 t))) 1566 t)))
1557 1567
1558 ;; RMS comments the next two out. 1568 ;; RMS comments the next two out.
1559 (defun byte-compile-and-load-file (&optional filename) 1569 (defun byte-compile-and-load-file (&optional filename)
1560 "Compile a file of Lisp code named FILENAME into a file of byte code, 1570 "Compile a file of Lisp code named FILENAME into a file of byte code,
1561 and then load it. The output file's name is made by appending \"c\" to 1571 and then load it. The output file's name is made by appending \"c\" to
1562 the end of FILENAME." 1572 the end of FILENAME."
1563 (interactive) 1573 (interactive)
1564 (if filename ; I don't get it, (interactive-p) doesn't always work 1574 (if filename ; I don't get it, (interactive-p) doesn't always work
1565 (byte-compile-file filename t) 1575 (byte-compile-file filename t)
1566 (let ((current-prefix-arg '(4))) 1576 (let ((current-prefix-arg '(4)))
1657 (byte-compile-file-form (read byte-compile-inbuffer))) 1667 (byte-compile-file-form (read byte-compile-inbuffer)))
1658 1668
1659 ;; Compile pending forms at end of file. 1669 ;; Compile pending forms at end of file.
1660 (byte-compile-flush-pending) 1670 (byte-compile-flush-pending)
1661 (byte-compile-warn-about-unresolved-functions) 1671 (byte-compile-warn-about-unresolved-functions)
1662 ;; SHould we always do this? When calling multiple files, it 1672 ;; Should we always do this? When calling multiple files, it
1663 ;; would be useful to delay this warning until all have 1673 ;; would be useful to delay this warning until all have
1664 ;; been compiled. 1674 ;; been compiled.
1665 (setq byte-compile-unresolved-functions nil))) 1675 (setq byte-compile-unresolved-functions nil)))
1666 (save-excursion 1676 (save-excursion
1667 (set-buffer byte-compile-outbuffer) 1677 (set-buffer byte-compile-outbuffer)
1766 (setq buffer-file-coding-system 'escape-quoted) 1776 (setq buffer-file-coding-system 'escape-quoted)
1767 ;; Lazy loading not yet implemented for MULE files 1777 ;; Lazy loading not yet implemented for MULE files
1768 ;; mrb - Fix this someday. 1778 ;; mrb - Fix this someday.
1769 (save-excursion 1779 (save-excursion
1770 (set-buffer byte-compile-inbuffer) 1780 (set-buffer byte-compile-inbuffer)
1771 (setq byte-compile-dynamic nil 1781 (setq byte-compile-dynamic nil
1772 byte-compile-dynamic-docstrings nil)) 1782 byte-compile-dynamic-docstrings nil))
1773 ;;(external-debugging-output (prin1-to-string (buffer-local-variables)))) 1783 ;;(external-debugging-output (prin1-to-string (buffer-local-variables))))
1774 )) 1784 ))
1775 ) 1785 )
1776 1786
1788 (eq (car form) 'autoload)) 1798 (eq (car form) 'autoload))
1789 (let ((print-escape-newlines t) 1799 (let ((print-escape-newlines t)
1790 (print-length nil) 1800 (print-length nil)
1791 (print-level nil) 1801 (print-level nil)
1792 (print-readably t) ; print #[] for bytecode, 'x for (quote x) 1802 (print-readably t) ; print #[] for bytecode, 'x for (quote x)
1793 ;; Emacs 19 can't handle gensyms well. 1803 (print-gensym (if (and byte-compile-print-gensym
1794 (print-gensym (if byte-compile-emacs19-compatibility nil 1804 (not byte-compile-emacs19-compatibility))
1795 t))) 1805 t nil)))
1796 (princ "\n" byte-compile-outbuffer) 1806 (princ "\n" byte-compile-outbuffer)
1797 (prin1 form byte-compile-outbuffer) 1807 (prin1 form byte-compile-outbuffer)
1798 nil))) 1808 nil)))
1799 1809
1800 (defun byte-compile-output-docform (preface name info form specindex quoted) 1810 (defun byte-compile-output-docform (preface name info form specindex quoted)
1841 (let ((print-escape-newlines t) 1851 (let ((print-escape-newlines t)
1842 (print-readably t) ; print #[] for bytecode, 'x for (quote x) 1852 (print-readably t) ; print #[] for bytecode, 'x for (quote x)
1843 ;; Use a cons cell to say that we want 1853 ;; Use a cons cell to say that we want
1844 ;; print-gensym-alist not to be cleared between calls 1854 ;; print-gensym-alist not to be cleared between calls
1845 ;; to print functions. 1855 ;; to print functions.
1846 (print-gensym (if byte-compile-emacs19-compatibility nil 1856 (print-gensym (if (and byte-compile-print-gensym
1847 '(t))) 1857 (not byte-compile-emacs19-compatibility))
1858 '(t) nil))
1848 print-gensym-alist 1859 print-gensym-alist
1849 (index 0)) 1860 (index 0))
1850 (prin1 (car form) byte-compile-outbuffer) 1861 (prin1 (car form) byte-compile-outbuffer)
1851 (while (setq form (cdr form)) 1862 (while (setq form (cdr form))
1852 (setq index (1+ index)) 1863 (setq index (1+ index))
1982 ;; We only use the names in the autoload environment, but 1993 ;; We only use the names in the autoload environment, but
1983 ;; it might be useful to have the bodies some day. 1994 ;; it might be useful to have the bodies some day.
1984 (setq byte-compile-autoload-environment 1995 (setq byte-compile-autoload-environment
1985 (cons (cons name form) 1996 (cons (cons name form)
1986 byte-compile-autoload-environment))))))) 1997 byte-compile-autoload-environment)))))))
1987 ;; 1998 ;;
1988 ;; Now output the form. 1999 ;; Now output the form.
1989 (if (stringp (nth 3 form)) 2000 (if (stringp (nth 3 form))
1990 form 2001 form
1991 ;; No doc string, so we can compile this as a normal form. 2002 ;; No doc string, so we can compile this as a normal form.
1992 (byte-compile-keep-pending form 'byte-compile-normal-call))) 2003 (byte-compile-keep-pending form 'byte-compile-normal-call)))
2062 ;; Much better than creating them and then "uncreating" them 2073 ;; Much better than creating them and then "uncreating" them
2063 ;; like this. 2074 ;; like this.
2064 (read (concat "(" 2075 (read (concat "("
2065 (substring (let ((print-readably t) 2076 (substring (let ((print-readably t)
2066 (print-gensym 2077 (print-gensym
2067 (if byte-compile-emacs19-compatibility nil 2078 (if (and byte-compile-print-gensym
2068 '(t))) 2079 (not byte-compile-emacs19-compatibility))
2080 '(t) nil))
2069 (print-gensym-alist nil)) 2081 (print-gensym-alist nil))
2070 (prin1-to-string obj)) 2082 (prin1-to-string obj))
2071 2 -1) 2083 2 -1)
2072 ")"))) 2084 ")")))
2073 2085
2180 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) 2192 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
2181 ((eq (car code) 'quote) 2193 ((eq (car code) 'quote)
2182 (setq code new-one) 2194 (setq code new-one)
2183 (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) 2195 (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
2184 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) 2196 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
2185 ;; The result of byte-compile-byte-code-maker is either a 2197 ;; The result of byte-compile-byte-code-maker is either a
2186 ;; compiled-function object, or a list of some kind. If it's 2198 ;; compiled-function object, or a list of some kind. If it's
2187 ;; not a cons, we must coerce it into a list of the elements 2199 ;; not a cons, we must coerce it into a list of the elements
2188 ;; to be printed to the file. 2200 ;; to be printed to the file.
2189 (if (consp code) 2201 (if (consp code)
2190 code 2202 code
2504 (byte-compile-out 'byte-return 0) 2516 (byte-compile-out 'byte-return 0)
2505 (setq byte-compile-output (nreverse byte-compile-output)) 2517 (setq byte-compile-output (nreverse byte-compile-output))
2506 (if (memq byte-optimize '(t byte)) 2518 (if (memq byte-optimize '(t byte))
2507 (setq byte-compile-output 2519 (setq byte-compile-output
2508 (byte-optimize-lapcode byte-compile-output for-effect))) 2520 (byte-optimize-lapcode byte-compile-output for-effect)))
2509 2521
2510 ;; Decompile trivial functions: 2522 ;; Decompile trivial functions:
2511 ;; only constants and variables, or a single funcall except in lambdas. 2523 ;; only constants and variables, or a single funcall except in lambdas.
2512 ;; Except for Lisp_Compiled objects, forms like (foo "hi") 2524 ;; Except for Lisp_Compiled objects, forms like (foo "hi")
2513 ;; are still quicker than (byte-code "..." [foo "hi"] 2). 2525 ;; are still quicker than (byte-code "..." [foo "hi"] 2).
2514 ;; Note that even (quote foo) must be parsed just as any subr by the 2526 ;; Note that even (quote foo) must be parsed just as any subr by the
2585 (cond ((eq (car-safe body) 'progn) 2597 (cond ((eq (car-safe body) 'progn)
2586 (cdr body)) 2598 (cdr body))
2587 (body 2599 (body
2588 (list body)))) 2600 (list body))))
2589 2601
2590 ;; This is the recursive entry point for compiling each subform of an 2602 ;; This is the recursive entry point for compiling each subform of an
2591 ;; expression. 2603 ;; expression.
2592 ;; If for-effect is non-nil, byte-compile-form will output a byte-discard 2604 ;; If for-effect is non-nil, byte-compile-form will output a byte-discard
2593 ;; before terminating (ie no value will be left on the stack). 2605 ;; before terminating (ie no value will be left on the stack).
2594 ;; A byte-compile handler may, when for-effect is non-nil, choose output code 2606 ;; A byte-compile handler may, when for-effect is non-nil, choose output code
2595 ;; which does not leave a value on the stack, and then set for-effect to nil 2607 ;; which does not leave a value on the stack, and then set for-effect to nil
2746 (0-1+1 . byte-compile-zero-or-one-arg-with-one-extra) 2758 (0-1+1 . byte-compile-zero-or-one-arg-with-one-extra)
2747 (1-2+1 . byte-compile-one-or-two-args-with-one-extra) 2759 (1-2+1 . byte-compile-one-or-two-args-with-one-extra)
2748 (2-3+1 . byte-compile-two-or-three-args-with-one-extra) 2760 (2-3+1 . byte-compile-two-or-three-args-with-one-extra)
2749 (0+2 . byte-compile-no-args-with-two-extra) 2761 (0+2 . byte-compile-no-args-with-two-extra)
2750 (1+2 . byte-compile-one-arg-with-two-extra) 2762 (1+2 . byte-compile-one-arg-with-two-extra)
2751 2763
2752 ))) 2764 )))
2753 compile-handler 2765 compile-handler
2754 (intern (concat "byte-compile-" 2766 (intern (concat "byte-compile-"
2755 (symbol-name function)))))))) 2767 (symbol-name function))))))))
2756 (if opcode 2768 (if opcode
2928 ;; means integral remainder and may have a negative result; `mod' is always 2940 ;; means integral remainder and may have a negative result; `mod' is always
2929 ;; positive, and accepts floating point args. All code which uses `mod' and 2941 ;; positive, and accepts floating point args. All code which uses `mod' and
2930 ;; requires the new interpretation must be compiled with bytecomp version 2.18 2942 ;; requires the new interpretation must be compiled with bytecomp version 2.18
2931 ;; or newer, or the emitted code will run the byte-code for `%' instead of an 2943 ;; or newer, or the emitted code will run the byte-code for `%' instead of an
2932 ;; actual call to `mod'. So be careful of compiling new code with an old 2944 ;; actual call to `mod'. So be careful of compiling new code with an old
2933 ;; compiler. Note also that `%' is more efficient than `mod' because the 2945 ;; compiler. Note also that `%' is more efficient than `mod' because the
2934 ;; former is byte-coded and the latter is not. 2946 ;; former is byte-coded and the latter is not.
2935 ;;(byte-defop-compiler (mod byte-rem) 2) 2947 ;;(byte-defop-compiler (mod byte-rem) 2)
2936 2948
2937 2949
2938 (defun byte-compile-subr-wrong-args (form n) 2950 (defun byte-compile-subr-wrong-args (form n)
3016 (let ((len (length form))) 3028 (let ((len (length form)))
3017 (cond ((= len 1) (byte-compile-one-arg (append form '(nil)))) 3029 (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
3018 ((= len 2) (byte-compile-one-arg form)) 3030 ((= len 2) (byte-compile-one-arg form))
3019 ((= len 3) (byte-compile-normal-call form)) 3031 ((= len 3) (byte-compile-normal-call form))
3020 (t (byte-compile-subr-wrong-args form "0-2"))))) 3032 (t (byte-compile-subr-wrong-args form "0-2")))))
3021 3033
3022 (defun byte-compile-one-or-two-args-with-one-extra (form) 3034 (defun byte-compile-one-or-two-args-with-one-extra (form)
3023 (let ((len (length form))) 3035 (let ((len (length form)))
3024 (cond ((= len 2) (byte-compile-two-args (append form '(nil)))) 3036 (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
3025 ((= len 3) (byte-compile-two-args form)) 3037 ((= len 3) (byte-compile-two-args form))
3026 ((= len 4) (byte-compile-normal-call form)) 3038 ((= len 4) (byte-compile-normal-call form))
3614 (prin1-to-string condition))) 3626 (prin1-to-string condition)))
3615 ;; ((not (or (eq condition 't) 3627 ;; ((not (or (eq condition 't)
3616 ;; (and (stringp (get condition 'error-message)) 3628 ;; (and (stringp (get condition 'error-message))
3617 ;; (consp (get condition 'error-conditions))))) 3629 ;; (consp (get condition 'error-conditions)))))
3618 ;; (byte-compile-warn 3630 ;; (byte-compile-warn
3619 ;; "%s is not a known condition name (in condition-case)" 3631 ;; "%s is not a known condition name (in condition-case)"
3620 ;; condition)) 3632 ;; condition))
3621 ) 3633 )
3622 (setq compiled-clauses 3634 (setq compiled-clauses
3623 (cons (cons condition 3635 (cons (cons condition
3624 (byte-compile-top-level-body 3636 (byte-compile-top-level-body
3721 ;; Put the defined variable in this library's load-history entry 3733 ;; Put the defined variable in this library's load-history entry
3722 ;; just as a real defvar would. 3734 ;; just as a real defvar would.
3723 (list 'setq 'current-load-list 3735 (list 'setq 'current-load-list
3724 (list 'cons (list 'quote var) 3736 (list 'cons (list 'quote var)
3725 'current-load-list)) 3737 'current-load-list))
3726 (if string 3738 (if string
3727 (list 'put (list 'quote var) ''variable-documentation string)) 3739 (list 'put (list 'quote var) ''variable-documentation string))
3728 (list 'quote var))))) 3740 (list 'quote var)))))
3729 3741
3730 (defun byte-compile-autoload (form) 3742 (defun byte-compile-autoload (form)
3731 (and (byte-compile-constp (nth 1 form)) 3743 (and (byte-compile-constp (nth 1 form))
3732 (byte-compile-constp (nth 5 form)) 3744 (byte-compile-constp (nth 5 form))
3733 (memq (eval (nth 5 form)) '(t macro)) ; macro-p 3745 (memq (eval (nth 5 form)) '(t macro)) ; macro-p
3734 (not (fboundp (eval (nth 1 form)))) 3746 (not (fboundp (eval (nth 1 form))))
3735 (byte-compile-warn 3747 (byte-compile-warn
3736 "The compiler ignores `autoload' except at top level. You should 3748 "The compiler ignores `autoload' except at top level. You should
3737 probably put the autoload of the macro `%s' at top-level." 3749 probably put the autoload of the macro `%s' at top-level."
3738 (eval (nth 1 form)))) 3750 (eval (nth 1 form))))
3739 (byte-compile-normal-call form)) 3751 (byte-compile-normal-call form))
3740 3752
3741 ;; Lambda's in valid places are handled as special cases by various code. 3753 ;; Lambda's in valid places are handled as special cases by various code.
3990 (defun batch-byte-compile () 4002 (defun batch-byte-compile ()
3991 "Run `byte-compile-file' on the files remaining on the command line. 4003 "Run `byte-compile-file' on the files remaining on the command line.
3992 Use this from the command line, with `-batch'; 4004 Use this from the command line, with `-batch';
3993 it won't work in an interactive Emacs. 4005 it won't work in an interactive Emacs.
3994 Each file is processed even if an error occurred previously. 4006 Each file is processed even if an error occurred previously.
3995 For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" 4007 For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
3996 ;; command-line-args-left is what is left of the command line (from 4008 ;; command-line-args-left is what is left of the command line (from
3997 ;; startup.el) 4009 ;; startup.el)
3998 (defvar command-line-args-left) ;Avoid 'free variable' warning 4010 (defvar command-line-args-left) ;Avoid 'free variable' warning
3999 (if (not noninteractive) 4011 (if (not noninteractive)
4000 (error "`batch-byte-compile' is to be used only with -batch")) 4012 (error "`batch-byte-compile' is to be used only with -batch"))