;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
"Emacs Lisp byte-compiler."
:group 'lisp)
-(defcustom emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
- "\\.EL\\(;[0-9]+\\)?$"
- "\\.el$")
- "*Regexp which matches Emacs Lisp source files.
+(defcustom emacs-lisp-file-regexp "\\.el\\'"
+ "Regexp which matches Emacs Lisp source files.
You may want to redefine the function `byte-compile-dest-file'
if you change this variable."
:group 'bytecomp
with the extension `.el'), add `c' to it; otherwise add `.elc'."
(setq filename (byte-compiler-base-file-name filename))
(setq filename (file-name-sans-versions filename))
- (cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
+ (cond ((string-match emacs-lisp-file-regexp filename)
(concat (substring filename 0 (match-beginning 0)) ".elc"))
(t (concat filename ".elc")))))
(defcustom byte-compile-verbose
(and (not noninteractive) (> baud-rate search-slow-speed))
- "*Non-nil means print messages describing progress of byte-compiler."
+ "Non-nil means print messages describing progress of byte-compiler."
:group 'bytecomp
:type 'boolean)
(defcustom byte-compile-compatibility nil
- "*Non-nil means generate output that can run in Emacs 18.
+ "Non-nil means generate output that can run in Emacs 18.
This only means that it can run in principle, if it doesn't require
facilities that have been added more recently."
:group 'bytecomp
;; this way can never be run in Emacs 18, and may even cause it to crash.")
(defcustom byte-optimize t
- "*Enable optimization in the byte compiler.
+ "Enable optimization in the byte compiler.
Possible values are:
nil - no optimization
t - all optimizations
(const :tag "byte-level" byte)))
(defcustom byte-compile-delete-errors nil
- "*If non-nil, the optimizer may delete forms that may signal an error.
+ "If non-nil, the optimizer may delete forms that may signal an error.
This includes variable references and calls to functions such as `car'."
:group 'bytecomp
:type 'boolean)
;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
(defcustom byte-compile-dynamic-docstrings t
- "*If non-nil, compile doc strings for lazy access.
-We bury the doc strings of functions and variables
-inside comments in the file, and bring them into core only when they
-are actually needed.
+ "If non-nil, compile doc strings for lazy access.
+We bury the doc strings of functions and variables inside comments in
+the file, and bring them into core only when they are actually needed.
When this option is true, if you load the compiled file and then move it,
you won't be able to find the documentation of anything in that file.
;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
(defcustom byte-optimize-log nil
- "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
+ "If true, the byte-compiler will log its optimizations into *Compile-Log*.
If this is 'source, then only source-level optimizations will be logged.
If it is 'byte, then only byte-level optimizations will be logged."
:group 'bytecomp
(const :tag "byte-level" byte)))
(defcustom byte-compile-error-on-warn nil
- "*If true, the byte-compiler reports warnings with `error'."
+ "If true, the byte-compiler reports warnings with `error'."
:group 'bytecomp
:type 'boolean)
make-local mapcar)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
- "*List of warnings that the byte-compiler should issue (t for all).
+ "List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be:
;;;###autoload
(defun byte-compile-warnings-safe-p (x)
+ "Return non-nil if X is valid as a value of `byte-compile-warnings'."
(or (booleanp x)
(and (listp x)
(if (eq (car x) 'not) (setq x (cdr x))
t)
(equal (mapcar
(lambda (e)
- (when (memq e '(free-vars unresolved
- callargs redefine
- obsolete noruntime
- cl-functions interactive-only
- make-local mapcar))
+ (when (memq e byte-compile-warning-types)
e))
x)
x))))
"If non-nil, this is a variable that shouldn't be reported as obsolete.")
(defcustom byte-compile-generate-call-tree nil
- "*Non-nil means collect call-graph information when compiling.
+ "Non-nil means collect call-graph information when compiling.
This records which functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.
If the value is neither t nor nil, compilation asks you whether to display
:type '(choice (const :tag "Yes" t) (const :tag "No" nil)
(other :tag "Ask" lambda)))
-(defvar byte-compile-call-tree nil "Alist of functions and their call tree.
+(defvar byte-compile-call-tree nil
+ "Alist of functions and their call tree.
Each element looks like
\(FUNCTION CALLERS CALLS\)
FUNCTION.")
(defcustom byte-compile-call-tree-sort 'name
- "*If non-nil, sort the call tree.
+ "If non-nil, sort the call tree.
The values `name', `callers', `calls', `calls+callers'
specify different fields to sort on."
:group 'bytecomp
(setcar (cdr bytes) (logand pc 255))
(setcar bytes (lsh pc -8))))
(setq patchlist (cdr patchlist))))
- (string-make-unibyte (concat (nreverse bytes)))))
+ (apply 'unibyte-string (nreverse bytes))))
\f
;;; compile-time evaluation
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-group nil)
(defvar byte-compile-current-buffer nil)
;; Log something that isn't a warning.
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
+(defun byte-compile-warn-obsolete (symbol)
+ "Warn that SYMBOL (a variable or function) is obsolete."
+ (when (byte-compile-warning-enabled-p 'obsolete)
+ (let* ((funcp (get symbol 'byte-obsolete-info))
+ (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
+ (instead (car obsolete))
+ (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+ (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
+ (if funcp "function" "variable")
+ (if asof (concat " (as of Emacs " asof ")") "")
+ (cond ((stringp instead)
+ (concat "; " instead))
+ (instead
+ (format "; use `%s' instead." instead))
+ (t "."))))))
+
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
(setq byte-compiler-error-flag t)
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
- (let* ((new (get (car form) 'byte-obsolete-info))
- (handler (nth 1 new))
- (when (nth 2 new)))
- (byte-compile-set-symbol-position (car form))
- (if (byte-compile-warning-enabled-p 'obsolete)
- (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car new))
- (car new)
- (format "use `%s' instead." (car new)))))
- (funcall (or handler 'byte-compile-normal-call) form)))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-warn-obsolete (car form))
+ (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
+ 'byte-compile-normal-call) form))
\f
;; Compiler options
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
- (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
- (or (not (eq (car-safe name) 'quote))
+ (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
+ byte-compile-current-group)
+ ;; The group will be provided implicitly.
+ nil
+ (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+ (name (cadr form)))
+ (or (not (eq (car-safe name) 'quote))
(and (eq (car form) 'custom-declare-group)
(equal name ''emacs))
(plist-get keyword-args :group)
(byte-compile-warn
"%s for `%s' fails to specify containing group"
(cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))))
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))
+ ;; Update the current group, if needed.
+ (if (and byte-compile-current-file ;Only when byte-compiling a whole file.
+ (eq (car form) 'custom-declare-group)
+ (eq (car-safe name) 'quote))
+ (setq byte-compile-current-group (cadr name))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(when (and (stringp (car elt))
(string-match
"^cl\\>" (file-name-nondirectory (car elt))))
- (setq byte-compile-cl-functions
- (append byte-compile-cl-functions
- (cdr elt)))))
- (let ((tail byte-compile-cl-functions))
- (while tail
- (if (and (consp (car tail))
- (eq (car (car tail)) 'autoload))
- (setcar tail (cdr (car tail))))
- (setq tail (cdr tail))))))
+ (dolist (e (cdr elt))
+ (when (memq (car-safe e) '(autoload defun))
+ (push (cdr e) byte-compile-cl-functions)))))))
(defun byte-compile-cl-warn (form)
"Warn if FORM is a call of a function from the CL package."
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
+;; The `bytecomp-' prefix is applied to all local variables with
+;; otherwise common names in this and similar functions for the sake
+;; of the boundp test in byte-compile-variable-ref.
+;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html
+;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html
;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
- "Recompile every `.el' file in DIRECTORY that needs recompilation.
-This is if a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of DIRECTORY are processed also.
+(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
+ bytecomp-force)
+ "Recompile every `.el' file in BYTECOMP-DIRECTORY that needs recompilation.
+This happens when a `.elc' file exists but is older than the `.el' file.
+Files in subdirectories of BYTECOMP-DIRECTORY are processed also.
If the `.elc' file does not exist, normally this function *does not*
-compile the corresponding `.el' file. However,
-if ARG (the prefix argument) is 0, that means do compile all those files.
-A nonzero ARG means ask the user, for each such `.el' file,
-whether to compile it.
-
-A nonzero ARG also means ask about each subdirectory before scanning it.
-
-If the third argument FORCE is non-nil,
-recompile every `.el' file that already has a `.elc' file."
+compile the corresponding `.el' file. However, if the prefix argument
+BYTECOMP-ARG is 0, that means do compile all those files. A nonzero
+BYTECOMP-ARG means ask the user, for each such `.el' file, whether to
+compile it. A nonzero BYTECOMP-ARG also means ask about each subdirectory
+before scanning it.
+
+If the third argument BYTECOMP-FORCE is non-nil, recompile every `.el' file
+that already has a `.elc' file."
(interactive "DByte recompile directory: \nP")
- (if arg
- (setq arg (prefix-numeric-value arg)))
+ (if bytecomp-arg
+ (setq bytecomp-arg (prefix-numeric-value bytecomp-arg)))
(if noninteractive
nil
(save-some-buffers)
(force-mode-line-update))
(with-current-buffer (get-buffer-create "*Compile-Log*")
- (setq default-directory (expand-file-name directory))
+ (setq default-directory (expand-file-name bytecomp-directory))
;; compilation-mode copies value of default-directory.
(unless (eq major-mode 'compilation-mode)
(compilation-mode))
- (let ((directories (list default-directory))
+ (let ((bytecomp-directories (list default-directory))
(default-directory default-directory)
(skip-count 0)
(fail-count 0)
(dir-count 0)
last-dir)
(displaying-byte-compile-warnings
- (while directories
- (setq directory (car directories))
- (message "Checking %s..." directory)
- (let ((files (directory-files directory))
- source dest)
- (dolist (file files)
- (setq source (expand-file-name file directory))
- (if (and (not (member file '("RCS" "CVS")))
- (not (eq ?\. (aref file 0)))
- (file-directory-p source)
- (not (file-symlink-p source)))
+ (while bytecomp-directories
+ (setq bytecomp-directory (car bytecomp-directories))
+ (message "Checking %s..." bytecomp-directory)
+ (let ((bytecomp-files (directory-files bytecomp-directory))
+ bytecomp-source bytecomp-dest)
+ (dolist (bytecomp-file bytecomp-files)
+ (setq bytecomp-source
+ (expand-file-name bytecomp-file bytecomp-directory))
+ (if (and (not (member bytecomp-file '("RCS" "CVS")))
+ (not (eq ?\. (aref bytecomp-file 0)))
+ (file-directory-p bytecomp-source)
+ (not (file-symlink-p bytecomp-source)))
;; This file is a subdirectory. Handle them differently.
- (when (or (null arg)
- (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories
- (nconc directories (list source))))
+ (when (or (null bytecomp-arg)
+ (eq 0 bytecomp-arg)
+ (y-or-n-p (concat "Check " bytecomp-source "? ")))
+ (setq bytecomp-directories
+ (nconc bytecomp-directories (list bytecomp-source))))
;; It is an ordinary file. Decide whether to compile it.
- (if (and (string-match emacs-lisp-file-regexp source)
- (file-readable-p source)
- (not (auto-save-file-name-p source))
- (setq dest (byte-compile-dest-file source))
- (if (file-exists-p dest)
+ (if (and (string-match emacs-lisp-file-regexp bytecomp-source)
+ (file-readable-p bytecomp-source)
+ (not (auto-save-file-name-p bytecomp-source))
+ (setq bytecomp-dest
+ (byte-compile-dest-file bytecomp-source))
+ (if (file-exists-p bytecomp-dest)
;; File was already compiled.
- (or force (file-newer-than-file-p source dest))
+ (or bytecomp-force
+ (file-newer-than-file-p bytecomp-source
+ bytecomp-dest))
;; No compiled file exists yet.
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile " source "? "))))))
+ (and bytecomp-arg
+ (or (eq 0 bytecomp-arg)
+ (y-or-n-p (concat "Compile "
+ bytecomp-source "? "))))))
(progn (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." source))
- (let ((res (byte-compile-file source)))
- (cond ((eq res 'no-byte-compile)
+ (message "Compiling %s..." bytecomp-source))
+ (let ((bytecomp-res (byte-compile-file
+ bytecomp-source)))
+ (cond ((eq bytecomp-res 'no-byte-compile)
(setq skip-count (1+ skip-count)))
- ((eq res t)
+ ((eq bytecomp-res t)
(setq file-count (1+ file-count)))
- ((eq res nil)
+ ((eq bytecomp-res nil)
(setq fail-count (1+ fail-count)))))
(or noninteractive
- (message "Checking %s..." directory))
- (if (not (eq last-dir directory))
- (setq last-dir directory
+ (message "Checking %s..." bytecomp-directory))
+ (if (not (eq last-dir bytecomp-directory))
+ (setq last-dir bytecomp-directory
dir-count (1+ dir-count)))
)))))
- (setq directories (cdr directories))))
+ (setq bytecomp-directories (cdr bytecomp-directories))))
(message "Done (Total of %d file%s compiled%s%s%s)"
file-count (if (= file-count 1) "" "s")
(if (> fail-count 0) (format ", %d failed" fail-count) "")
(if (> skip-count 0) (format ", %d skipped" skip-count) "")
- (if (> dir-count 1) (format " in %d directories" dir-count) "")))))
+ (if (> dir-count 1)
+ (format " in %d directories" dir-count) "")))))
(defvar no-byte-compile nil
- "Non-nil to prevent byte-compiling of emacs-lisp code.
+ "Non-nil to prevent byte-compiling of Emacs Lisp code.
This is normally set in local file variables at the end of the elisp file:
;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
;;;###autoload
-(defun byte-compile-file (filename &optional load)
- "Compile a file of Lisp code named FILENAME into a file of byte code.
-The output file's name is generated by passing FILENAME to the
-`byte-compile-dest-file' function (which see).
+(defun byte-compile-file (bytecomp-filename &optional load)
+ "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code.
+The output file's name is generated by passing BYTECOMP-FILENAME to the
+function `byte-compile-dest-file' (which see).
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors."
;; (interactive "fByte compile file: \nP")
(interactive
- (let ((file buffer-file-name)
- (file-name nil)
- (file-dir nil))
- (and file
+ (let ((bytecomp-file buffer-file-name)
+ (bytecomp-file-name nil)
+ (bytecomp-file-dir nil))
+ (and bytecomp-file
(eq (cdr (assq 'major-mode (buffer-local-variables)))
'emacs-lisp-mode)
- (setq file-name (file-name-nondirectory file)
- file-dir (file-name-directory file)))
+ (setq bytecomp-file-name (file-name-nondirectory bytecomp-file)
+ bytecomp-file-dir (file-name-directory bytecomp-file)))
(list (read-file-name (if current-prefix-arg
"Byte compile and load file: "
"Byte compile file: ")
- file-dir file-name nil)
+ bytecomp-file-dir bytecomp-file-name nil)
current-prefix-arg)))
;; Expand now so we get the current buffer's defaults
- (setq filename (expand-file-name filename))
+ (setq bytecomp-filename (expand-file-name bytecomp-filename))
;; If we're compiling a file that's in a buffer and is modified, offer
;; to save it first.
(or noninteractive
- (let ((b (get-file-buffer (expand-file-name filename))))
+ (let ((b (get-file-buffer (expand-file-name bytecomp-filename))))
(if (and b (buffer-modified-p b)
(y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(with-current-buffer b (save-buffer)))))
;; Force logging of the file name for each file compiled.
(setq byte-compile-last-logged-file nil)
- (let ((byte-compile-current-file filename)
+ (let ((byte-compile-current-file bytecomp-filename)
+ (byte-compile-current-group nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
- (setq target-file (byte-compile-dest-file filename))
+ (setq target-file (byte-compile-dest-file bytecomp-filename))
(setq byte-compile-dest-file target-file)
(with-current-buffer
(setq input-buffer (get-buffer-create " *Compiler Input*"))
;; Always compile an Emacs Lisp file as multibyte
;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
(set-buffer-multibyte t)
- (insert-file-contents filename)
+ (insert-file-contents bytecomp-filename)
;; Mimic the way after-insert-file-set-coding can make the
;; buffer unibyte when visiting this file.
(when (or (eq last-coding-system-used 'no-conversion)
(set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
- (let ((buffer-file-name filename)
+ (let ((buffer-file-name bytecomp-filename)
(default-major-mode 'emacs-lisp-mode)
;; Ignore unsafe local variables.
;; We only care about a few of them for our purposes.
(enable-local-eval nil))
;; Arg of t means don't alter enable-local-variables.
(normal-mode t)
- (setq filename buffer-file-name))
+ (setq bytecomp-filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
- (setq default-directory (file-name-directory filename)))
+ (setq default-directory (file-name-directory bytecomp-filename)))
;; Check if the file's local variables explicitly specify not to
;; compile this file.
(if (with-current-buffer input-buffer no-byte-compile)
(progn
;; (message "%s not compiled because of `no-byte-compile: %s'"
- ;; (file-relative-name filename)
+ ;; (file-relative-name bytecomp-filename)
;; (with-current-buffer input-buffer no-byte-compile))
(when (file-exists-p target-file)
(message "%s deleted because of `no-byte-compile: %s'"
;; We successfully didn't compile this file.
'no-byte-compile)
(when byte-compile-verbose
- (message "Compiling %s..." filename))
+ (message "Compiling %s..." bytecomp-filename))
(setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
;; within byte-compile-from-buffer lingers in that buffer.
(setq output-buffer
(save-current-buffer
- (byte-compile-from-buffer input-buffer filename)))
+ (byte-compile-from-buffer input-buffer bytecomp-filename)))
(if byte-compiler-error-flag
nil
(when byte-compile-verbose
- (message "Compiling %s...done" filename))
+ (message "Compiling %s...done" bytecomp-filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (let ((vms-stmlf-recfm t))
(if (file-writable-p target-file)
;; We must disable any code conversion here.
(let ((coding-system-for-write 'no-conversion))
(if (file-exists-p target-file)
"cannot overwrite file"
"directory not writable or nonexistent")
- target-file))))
+ target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
- (y-or-n-p (format "Report call tree for %s? " filename))))
+ (y-or-n-p (format "Report call tree for %s? "
+ bytecomp-filename))))
(save-excursion
- (display-call-tree filename)))
+ (display-call-tree bytecomp-filename)))
(if load
(load target-file))
t))))
(defun compile-defun (&optional arg)
"Compile and evaluate the current top-level form.
Print the result in the echo area.
-With argument, insert value in current buffer after the form."
+With argument ARG, insert value in current buffer after the form."
(interactive "P")
(save-excursion
(end-of-defun)
before INFO and the FORM but after the doc string itself.
If SPECINDEX is non-nil, it is the index in FORM
of the function bytecode string. In that case,
-we output that argument and the following argument (the constants vector)
-together, for lazy loading.
+we output that argument and the following argument
+\(the constants vector) together, for lazy loading.
QUOTED says that we have to put a quote before the
list that represents a doc string reference.
`autoload' and `custom-declare-variable' need that."
(t "variable reference to %s `%s'"))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
- (if (and (get var 'byte-obsolete-variable)
- (byte-compile-warning-enabled-p 'obsolete)
- (not (eq var byte-compile-not-obsolete-var)))
- (let* ((ob (get var 'byte-obsolete-variable))
- (when (cdr ob)))
- (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car ob))
- (car ob)
- (format "use `%s' instead." (car ob))))))
+ (and (get var 'byte-obsolete-variable)
+ (not (eq var byte-compile-not-obsolete-var))
+ (byte-compile-warn-obsolete var))
(if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(defun byte-compile-associative (form)
(if (cdr form)
(let ((opcode (get (car form) 'byte-opcode))
- (args (copy-sequence (cdr form))))
- (byte-compile-form (car args))
- (setq args (cdr args))
- (or args (setq args '(0)
- opcode (get '+ 'byte-opcode)))
- (dolist (arg args)
- (byte-compile-form arg)
- (byte-compile-out opcode 0)))
+ args)
+ (if (and (< 3 (length form))
+ (memq opcode (list (get '+ 'byte-opcode)
+ (get '* 'byte-opcode))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)
+ (setq args (copy-sequence (cdr form)))
+ (byte-compile-form (car args))
+ (setq args (cdr args))
+ (or args (setq args '(0)
+ opcode (get '+ 'byte-opcode)))
+ (dolist (arg args)
+ (byte-compile-form arg)
+ (byte-compile-out opcode 0))))
(byte-compile-constant (eval form))))
\f
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
- (if (null (setq form (cdr form)))
- (byte-compile-constant 0)
- (byte-compile-form (car form))
- (if (cdr form)
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-diff 0))
- (byte-compile-out 'byte-negate 0))))
+ (let ((len (length form)))
+ (cond
+ ((= 1 len) (byte-compile-constant 0))
+ ((= 2 len)
+ (byte-compile-form (cadr form))
+ (byte-compile-out 'byte-negate 0))
+ ((= 3 len)
+ (byte-compile-form (nth 1 form))
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out 'byte-diff 0))
+ ;; Don't use binary operations for > 2 operands, as that may
+ ;; cause overflow/truncation in float operations.
+ (t (byte-compile-normal-call form)))))
(defun byte-compile-quo (form)
(let ((len (length form)))
(cond ((<= len 2)
(byte-compile-subr-wrong-args form "2 or more"))
+ ((= len 3)
+ (byte-compile-two-args form))
(t
- (byte-compile-form (car (setq form (cdr form))))
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-quo 0))))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)))))
(defun byte-compile-nconc (form)
(let ((len (length form)))
(defmacro byte-compile-maybe-guarded (condition &rest body)
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
-BODY is the code to compile first arm of the if or the body of the
-cond clause. If CONDITION's value is of the form (fboundp 'foo)
+BODY is the code to compile in the first arm of the if or the body of
+the cond clause. If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
being undefined will be suppressed.
(byte-compile-bound-variables
(if bound-list
(append bound-list byte-compile-bound-variables)
- byte-compile-bound-variables))
- ;; Suppress all warnings, for code not used in Emacs.
- ;; FIXME: by the time this is executed the `featurep'
- ;; emacs/xemacs tests have been optimized away, so this is
- ;; not doing anything useful here, is should probably be
- ;; moved to a different place.
- ;; (byte-compile-warnings
- ;; (if (member ,condition '((featurep 'xemacs)
- ;; (not (featurep 'emacs))))
- ;; nil byte-compile-warnings))
- )
+ byte-compile-bound-variables)))
(unwind-protect
(progn ,@body)
;; Maybe remove the function symbol from the unresolved list.
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
;; Directory as argument.
- (let ((files (directory-files (car command-line-args-left)))
- source dest)
- (dolist (file files)
- (if (and (string-match emacs-lisp-file-regexp file)
- (not (auto-save-file-name-p file))
- (setq source (expand-file-name file
- (car command-line-args-left)))
- (setq dest (byte-compile-dest-file source))
- (file-exists-p dest)
- (file-newer-than-file-p source dest))
- (if (null (batch-byte-compile-file source))
+ (let ((bytecomp-files (directory-files (car command-line-args-left)))
+ bytecomp-source bytecomp-dest)
+ (dolist (bytecomp-file bytecomp-files)
+ (if (and (string-match emacs-lisp-file-regexp bytecomp-file)
+ (not (auto-save-file-name-p bytecomp-file))
+ (setq bytecomp-source
+ (expand-file-name bytecomp-file
+ (car command-line-args-left)))
+ (setq bytecomp-dest (byte-compile-dest-file
+ bytecomp-source))
+ (file-exists-p bytecomp-dest)
+ (file-newer-than-file-p bytecomp-source bytecomp-dest))
+ (if (null (batch-byte-compile-file bytecomp-source))
(setq error t)))))
;; Specific file argument
(if (or (not noforce)
- (let* ((source (car command-line-args-left))
- (dest (byte-compile-dest-file source)))
- (or (not (file-exists-p dest))
- (file-newer-than-file-p source dest))))
+ (let* ((bytecomp-source (car command-line-args-left))
+ (bytecomp-dest (byte-compile-dest-file bytecomp-source)))
+ (or (not (file-exists-p bytecomp-dest))
+ (file-newer-than-file-p bytecomp-source bytecomp-dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
(setq error t))))
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs (if error 1 0))))
-(defun batch-byte-compile-file (file)
+(defun batch-byte-compile-file (bytecomp-file)
(if debug-on-error
- (byte-compile-file file)
+ (byte-compile-file bytecomp-file)
(condition-case err
- (byte-compile-file file)
+ (byte-compile-file bytecomp-file)
(file-error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- file
+ bytecomp-file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
- (let ((destfile (byte-compile-dest-file file)))
- (if (file-exists-p destfile)
- (delete-file destfile)))
+ (let ((bytecomp-destfile (byte-compile-dest-file bytecomp-file)))
+ (if (file-exists-p bytecomp-destfile)
+ (delete-file bytecomp-destfile)))
nil)
(error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- file
+ bytecomp-file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
nil))))