X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eef899a997311fb9d0809e01e794cde24126dc6b..9ae0c31028f246f77a16f4989d5c63bfbbee4832:/lisp/emacs-lisp/bytecomp.el diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3f330703d5..0c3a7b6979 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,7 +1,7 @@ ;;; 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 ;; Hallvard Furuseth @@ -122,37 +122,6 @@ ;; 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) @@ -221,13 +190,6 @@ adds `c' to it; otherwise adds `.elc'." :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: @@ -301,7 +263,7 @@ If it is 'byte, then only byte-level optimizations will be logged." (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). @@ -323,17 +285,15 @@ Elements of the list may be: 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 @@ -439,15 +399,6 @@ specify different fields to sort on." (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 @@ -1123,64 +1074,6 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler 'byte-compile-normal-call) form)) -;; 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)) - ;;; sanity-checking arglists (defun byte-compile-fdefinition (name macro-p) @@ -1829,28 +1722,6 @@ The value is non-nil if there were no errors, nil if errors." (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 "#"))) -;; (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) @@ -1922,10 +1793,9 @@ With argument ARG, insert value in current buffer after the form." ;; 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 @@ -1958,49 +1828,55 @@ and will be removed soon. See (elisp)Backquote in the manual.")) ;; 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 @@ -2009,62 +1885,38 @@ and will be removed soon. See (elisp)Backquote in the manual.")) ;; 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. @@ -2072,17 +1924,18 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (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) @@ -2106,7 +1959,7 @@ 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." +`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)) @@ -3480,21 +3333,31 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (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)))) @@ -3860,6 +3723,9 @@ that suppresses all warnings during execution of BODY." (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)) @@ -3950,8 +3816,8 @@ that suppresses all warnings during execution of BODY." `(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)))