;;; 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, 2009 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; This really ought to be loaded already!
(load "byte-run"))
-;; The feature of compiling in a specific target Emacs version
-;; has been turned off because compile time options are a bad idea.
-(defmacro byte-compile-single-version () nil)
-
-;; The crud you see scattered through this file of the form
-;; (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19"))
-;; is because the Epoch folks couldn't be bothered to follow the
-;; normal emacs version numbering convention.
-
-;; (if (byte-compile-version-cond
-;; (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19")))
-;; (progn
-;; ;; emacs-18 compatibility.
-;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
-;;
-;; (if (byte-compile-single-version)
-;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
-;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
-;;
-;; (or (and (fboundp 'member)
-;; ;; avoid using someone else's possibly bogus definition of this.
-;; (subrp (symbol-function 'member)))
-;; (defun member (elt list)
-;; "like memq, but uses equal instead of eq. In v19, this is a subr."
-;; (while (and list (not (equal elt (car list))))
-;; (setq list (cdr list)))
-;; list))))
-
-
(defgroup bytecomp nil
"Emacs Lisp byte-compiler."
:group 'lisp)
:group 'bytecomp
:type 'boolean)
-;; (defvar byte-compile-generate-emacs19-bytecodes
-;; (not (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19")))
-;; "*If this is true, then the byte-compiler will generate bytecode which
-;; makes use of byte-ops which are present only in Emacs 19. Code generated
-;; 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.
Possible values are:
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only
- make-local mapcar constants)
+ make-local mapcar constants suspicious)
"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).
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
constants let-binding of, or assignment to, constants/nonvariables.
+ suspicious constructs that usually don't do what the coder wanted.
If the list begins with `not', then the remaining elements specify warnings to
suppress. For example, (not mapcar) will suppress warnings about mapcar."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
- (const free-vars) (const unresolved)
- (const callargs) (const redefine)
- (const obsolete) (const noruntime)
- (const cl-functions) (const interactive-only)
- (const make-local) (const mapcar) (const constants))))
+ ,@(mapcar (lambda (x) `(const ,x))
+ byte-compile-warning-types))))
;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
;;;###autoload
(const calls+callers) (const nil)))
(defvar byte-compile-debug nil)
-
-;; (defvar byte-compile-overwrite-file t
-;; "If nil, old .elc files are deleted before the new is saved, and .elc
-;; files will have the same modes as the corresponding .el file. Otherwise,
-;; existing .elc files will simply be overwritten, and the existing modes
-;; will not be changed. If this variable is nil, then an .elc file which
-;; is a symbolic link will be turned into a normal file, instead of the file
-;; which the link points to being overwritten.")
-
(defvar byte-compile-constants nil
"List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
(funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
'byte-compile-normal-call) form))
\f
-;; Compiler options
-
-;; (defvar byte-compiler-valid-options
-;; '((optimize byte-optimize (t nil source byte) val)
-;; (file-format byte-compile-compatibility (emacs18 emacs19)
-;; (eq val 'emacs18))
-;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val)
-;; (delete-errors byte-compile-delete-errors (t nil) val)
-;; (verbose byte-compile-verbose (t nil) val)
-;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
-;; val)))
-
-;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
-;; than can't be changed because the running compiler doesn't support it.
-;; (cond
-;; ((byte-compile-single-version)
-;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
-;; (list (byte-compile-version-cond
-;; byte-compile-generate-emacs19-bytecodes)))
-;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options)))
-;; (if (byte-compile-version-cond byte-compile-compatibility)
-;; '(emacs18) '(emacs19)))))
-
-;; (defun byte-compiler-options-handler (&rest args)
-;; (let (key val desc choices)
-;; (while args
-;; (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
-;; (error "Malformed byte-compiler option `%s'" (car args)))
-;; (setq key (car (car args))
-;; val (car (cdr (car args)))
-;; desc (assq key byte-compiler-valid-options))
-;; (or desc
-;; (error "Unknown byte-compiler option `%s'" key))
-;; (setq choices (nth 2 desc))
-;; (if (consp (car choices))
-;; (let (this
-;; (handler 'cons)
-;; (ret (and (memq (car val) '(+ -))
-;; (copy-sequence (if (eq t (symbol-value (nth 1 desc)))
-;; choices
-;; (symbol-value (nth 1 desc)))))))
-;; (setq choices (car choices))
-;; (while val
-;; (setq this (car val))
-;; (cond ((memq this choices)
-;; (setq ret (funcall handler this ret)))
-;; ((eq this '+) (setq handler 'cons))
-;; ((eq this '-) (setq handler 'delq))
-;; ((error "`%s' only accepts %s" key choices)))
-;; (setq val (cdr val)))
-;; (set (nth 1 desc) ret))
-;; (or (memq val choices)
-;; (error "`%s' must be one of `%s'" key choices))
-;; (set (nth 1 desc) (eval (nth 3 desc))))
-;; (setq args (cdr args)))
-;; nil))
-\f
;;; sanity-checking arglists
(defun byte-compile-fdefinition (name macro-p)
(load target-file))
t))))
-;;(defun byte-compile-and-load-file (&optional filename)
-;; "Compile a file of Lisp code named FILENAME into a file of byte code,
-;;and then load it. The output file's name is made by appending \"c\" to
-;;the end of FILENAME."
-;; (interactive)
-;; (if filename ; I don't get it, (interactive-p) doesn't always work
-;; (byte-compile-file filename t)
-;; (let ((current-prefix-arg '(4)))
-;; (call-interactively 'byte-compile-file))))
-
-;;(defun byte-compile-buffer (&optional buffer)
-;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
-;; (interactive "bByte compile buffer: ")
-;; (setq buffer (if buffer (get-buffer buffer) (current-buffer)))
-;; (message "Compiling %s..." (buffer-name buffer))
-;; (let* ((filename (or (buffer-file-name buffer)
-;; (concat "#<buffer " (buffer-name buffer) ">")))
-;; (byte-compile-current-file buffer))
-;; (byte-compile-from-buffer buffer nil))
-;; (message "Compiling %s...done" (buffer-name buffer))
-;; t)
-
;;; compiling a single function
;;;###autoload
(defun compile-defun (&optional arg)
;; need to be written carefully.
(setq overwrite-mode 'overwrite-mode-binary))
(displaying-byte-compile-warnings
- (and bytecomp-filename
- (byte-compile-insert-header bytecomp-filename bytecomp-inbuffer
- bytecomp-outbuffer))
(with-current-buffer bytecomp-inbuffer
+ (and bytecomp-filename
+ (byte-compile-insert-header bytecomp-filename bytecomp-outbuffer))
(goto-char (point-min))
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have been
;; Fix up the header at the front of the output
;; if the buffer contains multibyte characters.
(and bytecomp-filename
- (byte-compile-fix-header bytecomp-filename bytecomp-inbuffer
- bytecomp-outbuffer))))
+ (with-current-buffer bytecomp-outbuffer
+ (byte-compile-fix-header bytecomp-filename)))))
bytecomp-outbuffer))
-(defun byte-compile-fix-header (filename inbuffer outbuffer)
- (with-current-buffer outbuffer
- ;; See if the buffer has any multibyte characters.
- (when (< (point-max) (position-bytes (point-max)))
- (goto-char (point-min))
- ;; Find the comment that describes the version test.
- (search-forward "\n;;; This file")
- (beginning-of-line)
- (narrow-to-region (point) (point-max))
- ;; Find the line of ballast semicolons.
- (search-forward ";;;;;;;;;;")
- (beginning-of-line)
-
- (narrow-to-region (point-min) (point))
- (let ((old-header-end (point))
- delta)
- (goto-char (point-min))
- (delete-region (point) (progn (re-search-forward "^(")
- (beginning-of-line)
- (point)))
- (insert ";;; This file contains utf-8 non-ASCII characters\n"
- ";;; and therefore cannot be loaded into Emacs 22 or earlier.\n")
- ;; Replace "19" or "19.29" with "23", twice.
- (re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "23")
- (re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "23")
- ;; Now compensate for the change in size,
- ;; to make sure all positions in the file remain valid.
- (setq delta (- (point-max) old-header-end))
- (goto-char (point-max))
- (widen)
- (delete-char delta)))))
-
-(defun byte-compile-insert-header (filename inbuffer outbuffer)
- (with-current-buffer inbuffer
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic))
- (set-buffer outbuffer)
+(defun byte-compile-fix-header (filename)
+ "If the current buffer has any multibyte characters, insert a version test."
+ (when (< (point-max) (position-bytes (point-max)))
+ (goto-char (point-min))
+ ;; Find the comment that describes the version condition.
+ (search-forward "\n;;; This file uses")
+ (narrow-to-region (line-beginning-position) (point-max))
+ ;; Find the first line of ballast semicolons.
+ (search-forward ";;;;;;;;;;")
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point))
+ (let ((old-header-end (point))
+ (minimum-version "23")
+ delta)
+ (delete-region (point-min) (point-max))
+ (insert
+ ";;; This file contains utf-8 non-ASCII characters,\n"
+ ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "(and (boundp 'emacs-version)\n"
+ ;; If there is a name at the end of emacs-version,
+ ;; don't try to check the version number.
+ " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
+ (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ (format "' was compiled for Emacs %s or later\"))\n\n"
+ minimum-version))
+ ;; Now compensate for any change in size, to make sure all
+ ;; positions in the file remain valid.
+ (setq delta (- (point-max) old-header-end))
+ (goto-char (point-max))
+ (widen)
+ (delete-char delta))))
+
+(defun byte-compile-insert-header (filename outbuffer)
+ "Insert a header at the start of OUTBUFFER.
+Call from the source buffer."
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
+ (dynamic byte-compile-dynamic)
+ (optimize byte-optimize))
+ (with-current-buffer outbuffer
(goto-char (point-min))
;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
;; that is the file-format version number (18, 19, 20, or 23) as a
;; the file so that `diff' will simply say "Binary files differ"
;; instead of actually doing a diff of two .elc files. An extra
;; benefit is that you can add this to /etc/magic:
-
;; 0 string ;ELC GNU Emacs Lisp compiled file,
;; >4 byte x version %d
-
- (insert ";ELC" 23 "\000\000\000\n")
- (insert ";;; Compiled by "
- (or (and (boundp 'user-mail-address) user-mail-address)
- (concat (user-login-name) "@" (system-name)))
- " on "
- (current-time-string) "\n;;; from file " filename "\n")
- (insert ";;; in Emacs version " emacs-version "\n")
- (insert ";;; "
- (cond
- ((eq byte-optimize 'source) "with source-level optimization only")
- ((eq byte-optimize 'byte) "with byte-level optimization only")
- (byte-optimize "with all optimizations")
- (t "without optimization"))
- ".\n")
- (if dynamic
- (insert ";;; Function definitions are lazy-loaded.\n"))
- (let (intro-string minimum-version)
- ;; Figure out which Emacs version to require,
- ;; and what comment to use to explain why.
- ;; Note that this fails to take account of whether
- ;; the buffer contains multibyte characters. We may have to
- ;; compensate at the end in byte-compile-fix-header.
- (if dynamic-docstrings
- (setq intro-string
- ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
- minimum-version "19.29")
- (setq intro-string
- ";;; This file uses opcodes which do not exist in Emacs 18.\n"
- minimum-version "19"))
- ;; Now insert the comment and the error check.
- (insert
- "\n"
- intro-string
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(if (and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- "\t (or (and (boundp 'epoch::version) epoch::version)\n"
- (format "\t (string-lessp emacs-version \"%s\")))\n"
- minimum-version)
- " (error \"`"
- ;; prin1-to-string is used to quote backslashes.
- (substring (prin1-to-string (file-name-nondirectory filename))
- 1 -1)
- (format "' was compiled for Emacs %s or later\"))\n\n"
- minimum-version)
- ;; Insert semicolons as ballast, so that byte-compile-fix-header
- ;; can delete them so as to keep the buffer positions
- ;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))))
+ (insert
+ ";ELC" 23 "\000\000\000\n"
+ ";;; Compiled by "
+ (or (and (boundp 'user-mail-address) user-mail-address)
+ (concat (user-login-name) "@" (system-name)))
+ " on " (current-time-string) "\n"
+ ";;; from file " filename "\n"
+ ";;; in Emacs version " emacs-version "\n"
+ ";;; with"
+ (cond
+ ((eq optimize 'source) " source-level optimization only")
+ ((eq optimize 'byte) " byte-level optimization only")
+ (optimize " all optimizations")
+ (t "out optimization"))
+ ".\n"
+ (if dynamic ";;; Function definitions are lazy-loaded.\n"
+ "")
+ "\n;;; This file uses "
+ (if dynamic-docstrings
+ "dynamic docstrings, first added in Emacs 19.29"
+ "opcodes that do not exist in Emacs 18")
+ ".\n\n"
+ ;; Note that byte-compile-fix-header may change this.
+ ";;; This file does not contain utf-8 non-ASCII characters,\n"
+ ";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
+ ;; Insert semicolons as ballast, so that byte-compile-fix-header
+ ;; can delete them so as to keep the buffer positions
+ ;; constant for the actual compiled code.
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defun byte-compile-output-file-form (form)
;; writes the given form to the output buffer, being careful of docstrings
- ;; in defun, defmacro, defvar, defconst, autoload and
+ ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
;; custom-declare-variable because make-docfile is so amazingly stupid.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload
+ (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload
custom-declare-variable))
(stringp (nth 3 form)))
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
(memq (car form)
- '(autoload custom-declare-variable)))
+ '(defvaralias autoload
+ custom-declare-variable)))
(let ((print-escape-newlines t)
(print-length nil)
(print-level nil)
\(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."
+`defvaralias', `autoload' and `custom-declare-variable' need that."
;; We need to examine byte-compile-dynamic-docstrings
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
- (let ((bytecomp-args (cdr form))
- setters)
- (while bytecomp-args
- (let ((var (car bytecomp-args)))
- (and (or (not (symbolp var))
- (byte-compile-const-symbol-p var t))
- (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn
- "variable assignment to %s `%s'"
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))
- (push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
- setters))
- (setq bytecomp-args (cdr (cdr bytecomp-args))))
- (byte-compile-form (cons 'progn (nreverse setters)))))
+ (setq form (cdr form))
+ (if (> (length form) 2)
+ (let ((setters ()))
+ (while (consp form)
+ (push `(setq-default ,(pop form) ,(pop form)) setters))
+ (byte-compile-form (cons 'progn (nreverse setters))))
+ (let ((var (car form)))
+ (and (or (not (symbolp var))
+ (byte-compile-const-symbol-p var t))
+ (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))
+ (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+
+(byte-defop-compiler-1 set-default)
+(defun byte-compile-set-default (form)
+ (let ((varexp (car-safe (cdr-safe form))))
+ (if (eq (car-safe varexp) 'quote)
+ ;; If the varexp is constant, compile it as a setq-default
+ ;; so we get more warnings.
+ (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
+ ,@(cddr form)))
+ (byte-compile-normal-call form))))
(defun byte-compile-quote (form)
(byte-compile-constant (car (cdr form))))
(defun byte-compile-save-excursion (form)
+ (if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
+ (byte-compile-warning-enabled-p 'suspicious))
+ (byte-compile-warn "`save-excursion' defeated by `set-buffer'"))
(byte-compile-out 'byte-save-excursion 0)
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
`(push ',var current-load-list))
(when (> (length form) 3)
(when (and string (not (stringp string)))
- (byte-compile-warn "third arg to `%s %s' is not a string: %s"
- fun var string))
+ (byte-compile-warn "third arg to `%s %s' is not a string: %s"
+ fun var string))
`(put ',var 'variable-documentation ,string))
(if (cddr form) ; `value' provided
(let ((byte-compile-not-obsolete-vars (list var)))