X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/347a36bc5bd7d078c83da6a83397738f839c58b7..44b254cc4f3aa7a3f14691f0098782c35c0abdab:/lisp/emacs-lisp/bytecomp.el

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 3a0e7da2b1..32d6694b06 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code
 
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002
+;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
@@ -8,10 +8,6 @@
 ;; Maintainer: FSF
 ;; Keywords: lisp
 
-;;; This version incorporates changes up to version 2.10 of the
-;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.120 $")
-
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -75,7 +71,7 @@
 ;; User customization variables:
 ;;
 ;; byte-compile-verbose	Whether to report the function currently being
-;;				compiled in the minibuffer;
+;;				compiled in the echo area;
 ;; byte-optimize		Whether to do optimizations; this may be
 ;;				t, nil, 'source, or 'byte;
 ;; byte-optimize-log		Whether to report (in excruciating detail)
@@ -91,17 +87,17 @@
 ;;				finding unused functions, as well as simple
 ;;				performance metering.
 ;; byte-compile-warnings	List of warnings to issue, or t.  May contain
-;;				'free-vars (references to variables not in the
-;;					    current lexical scope)
-;;				'unresolved (calls to unknown functions)
-;;				'callargs  (lambda calls with args that don't
-;;					    match the lambda's definition)
-;;				'redefine  (function cell redefined from
-;;					    a macro to a lambda or vice versa,
-;;					    or redefined to take other args)
-;;				'obsolete  (obsolete variables and functions)
-;;				'noruntime (calls to functions only defined
-;;					    within `eval-when-compile')
+;;				`free-vars' (references to variables not in the
+;;					     current lexical scope)
+;;				`unresolved' (calls to unknown functions)
+;;				`callargs'  (lambda calls with args that don't
+;;					     match the lambda's definition)
+;;				`redefine'  (function cell redefined from
+;;					     a macro to a lambda or vice versa,
+;;					     or redefined to take other args)
+;;				`obsolete'  (obsolete variables and functions)
+;;				`noruntime' (calls to functions only defined
+;;					     within `eval-when-compile')
 ;; byte-compile-compatibility	Whether the compiler should
 ;;				generate .elc files which can be loaded into
 ;;				generic emacs 18.
@@ -130,7 +126,7 @@
 ;;		 (baz 0))
 ;;
 ;;  o	It is possible to open-code a function in the same file it is defined
-;;	in without having to load that file before compiling it.  the
+;;	in without having to load that file before compiling it.  The
 ;;	byte-compiler has been modified to remember function definitions in
 ;;	the compilation environment in the same way that it remembers macro
 ;;	definitions.
@@ -159,7 +155,7 @@
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
-    (load-library "byte-run"))
+    (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.
@@ -251,7 +247,9 @@ if you change this variable."
   :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
   :type 'boolean)
 
@@ -351,6 +349,9 @@ Elements of the list may be be:
 		      (const callargs) (const redefine)
 		      (const obsolete) (const noruntime) (const cl-functions))))
 
+(defvar byte-compile-not-obsolete-var nil
+  "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.
 This records functions were called and from where.
@@ -403,6 +404,8 @@ specify different fields to sort on."
 (defvar byte-compile-bound-variables nil
   "List of variables bound in the context of the current form.
 This list lives partly on the stack.")
+(defvar byte-compile-const-variables nil
+  "List of variables declared as constants during compilation of this file.")
 (defvar byte-compile-free-references)
 (defvar byte-compile-free-assignments)
 
@@ -439,6 +442,11 @@ Each element looks like (FUNCTIONNAME . DEFINITION).  It is
 Used for warnings when the function is not known to be defined or is later
 defined with incorrect args.")
 
+(defvar byte-compile-noruntime-functions nil
+  "Alist of functions called that may not be defined when the compiled code is run.
+Used for warnings about calling a function that is defined during compilation
+but won't necessarily be defined when the compiled file is loaded.")
+
 (defvar byte-compile-tag-number 0)
 (defvar byte-compile-output nil
   "Alist describing contents to put in byte code string.
@@ -707,8 +715,7 @@ otherwise pop it")
   (let ((pc 0)			; Program counter
 	op off			; Operation & offset
 	(bytes '())		; Put the output bytes here
-	(patchlist nil)		; List of tags and goto's to patch
-	rest rel tmp)
+	(patchlist nil))	; List of tags and goto's to patch
     (while lap
       (setq op (car (car lap))
 	    off (cdr (car lap)))
@@ -772,7 +779,7 @@ otherwise pop it")
 
 (defun byte-compile-eval (form)
   "Eval FORM and mark the functions defined therein.
-Each function's symbol gets marked with the `byte-compile-noruntime' property."
+Each function's symbol gets added to `byte-compile-noruntime-functions'."
   (let ((hist-orig load-history)
 	(hist-nil-orig current-load-list))
     (prog1 (eval form)
@@ -790,19 +797,19 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 		  (cond
 		   ((symbolp s)
 		    (unless (memq s old-autoloads)
-		      (put s 'byte-compile-noruntime t)))
+		      (push s byte-compile-noruntime-functions)))
 		   ((and (consp s) (eq t (car s)))
-		    (push s old-autoloads))
+		    (push (cdr s) old-autoloads))
 		   ((and (consp s) (eq 'autoload (car s)))
-		    (put (cdr s) 'byte-compile-noruntime t)))))))
+		    (push (cdr s) byte-compile-noruntime-functions)))))))
 	  ;; Go through current-load-list for the locally defined funs.
 	  (let (old-autoloads)
 	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
 	      (let ((s (pop hist-nil-new)))
 		(when (and (symbolp s) (not (memq s old-autoloads)))
-		  (put s 'byte-compile-noruntime t))
+		  (push s byte-compile-noruntime-functions))
 		(when (and (consp s) (eq t (car s)))
-		  (push s old-autoloads))))))))))
+		  (push (cdr s) old-autoloads))))))))))
 
 (defun byte-compile-eval-before-compile (form)
   "Evaluate FORM for `eval-and-compile'."
@@ -925,7 +932,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
     (when (or (and byte-compile-current-file
 		   (not (equal byte-compile-current-file
 			       byte-compile-last-logged-file)))
-	      (and byte-compile-last-warned-form
+	      (and byte-compile-current-form
 		   (not (eq byte-compile-current-form
 			    byte-compile-last-warned-form))))
       (insert (format "\nIn %s:\n" form)))
@@ -948,7 +955,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
        (not noninteractive)
        (save-excursion
-	 (byte-goto-log-buffer)
+	 (set-buffer (get-buffer-create "*Compile-Log*"))
 	 (goto-char (point-max))
 	 (let* ((dir (and byte-compile-current-file
 			  (file-name-directory byte-compile-current-file)))
@@ -971,14 +978,18 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 	     (setq default-directory dir)
 	     (unless was-same
 	       (insert (format "Entering directory `%s'\n" default-directory))))
-	   (setq byte-compile-last-logged-file byte-compile-current-file)
+	   (setq byte-compile-last-logged-file byte-compile-current-file
+		 byte-compile-last-warned-form nil)
+	   ;; Do this after setting default-directory.
+	   (unless (eq major-mode 'compilation-mode)
+	     (compilation-mode))
 	   pt))))
 
 ;; Log a message STRING in *Compile-Log*.
 ;; Also log the current function and file if not already done.
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)
-	(warning-group-format "")
+	(warning-type-format "")
 	(warning-fill-prefix (if fill "    ")))
     (display-warning 'bytecomp string level "*Compile-Log*")))
 
@@ -1162,10 +1173,11 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 	       "requires"
 	     "accepts only")
 	   (byte-compile-arglist-signature-string sig))))
+    (byte-compile-format-warn form)
     ;; Check to see if the function will be available at runtime
     ;; and/or remember its arity if it's unknown.
     (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
-	     (not (get (car form) 'byte-compile-noruntime)))
+	     (not (memq (car form) byte-compile-noruntime-functions)))
 	(eq (car form) byte-compile-current-form) ; ## this doesn't work
 					; with recursion.
 	;; It's a currently-undefined function.
@@ -1179,6 +1191,32 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 		  (cons (list (car form) n)
 			byte-compile-unresolved-functions)))))))
 
+(defun byte-compile-format-warn (form)
+  "Warn if FORM is `format'-like with inconsistent args.
+Applies if head of FORM is a symbol with non-nil property
+`byte-compile-format-like' and first arg is a constant string.
+Then check the number of format fields matches the number of
+extra args."
+  (when (and (symbolp (car form))
+	     (stringp (nth 1 form))
+	     (get (car form) 'byte-compile-format-like))
+    (let ((nfields (with-temp-buffer
+		     (insert (nth 1 form))
+		     (goto-char 1)
+		     (let ((n 0))
+		       (while (re-search-forward "%." nil t)
+			 (unless (eq ?% (char-after (1+ (match-beginning 0))))
+			   (setq n (1+ n))))
+		       n)))
+	  (nargs (- (length form) 2)))
+      (unless (= nargs nfields)
+	(byte-compile-warn
+	 "`%s' called with %d args to fill %d format field(s)" (car form)
+	 nargs nfields)))))
+
+(dolist (elt '(format message error))
+  (put elt 'byte-compile-format-like t))
+
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (form macrop)
@@ -1246,7 +1284,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   (let ((func (car-safe form)))
     (if (and byte-compile-cl-functions
 	     (memq func byte-compile-cl-functions)
-	     ;; Aliases which won't have been expended at this point.
+	     ;; Aliases which won't have been expanded at this point.
 	     ;; These aren't all aliases of subrs, so not trivial to
 	     ;; avoid hardwiring the list.
 	     (not (memq func
@@ -1260,7 +1298,15 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 			  ;; These would sometimes be warned about
 			  ;; but such warnings are never useful,
 			  ;; so don't warn about them.
-			  macroexpand cl-macroexpand-all cl-compiling-file))))
+			  macroexpand cl-macroexpand-all
+			  cl-compiling-file)))
+	     ;; Avoid warnings for things which are safe because they
+	     ;; have suitable compiler macros, but those aren't
+	     ;; expanded at this stage.  There should probably be more
+	     ;; here than caaar and friends.
+	     (not (and (eq (get func 'byte-compile)
+			   'cl-byte-compile-compiler-macro)
+		       (string-match "\\`c[ad]+r\\'" (symbol-name func)))))
 	(byte-compile-warn "Function `%s' from cl package called at runtime"
 			   func)))
   form)
@@ -1314,9 +1360,13 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   nil)
 
 
-(defsubst byte-compile-const-symbol-p (symbol)
+(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
+  "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."
   (or (memq symbol '(nil t))
-      (keywordp symbol)))
+      (keywordp symbol)
+      (if any-value (memq symbol byte-compile-const-variables))))
 
 (defmacro byte-compile-constp (form)
   "Return non-nil if FORM is a constant."
@@ -1336,6 +1386,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 		 (copy-alist byte-compile-initial-macro-environment))
 		(byte-compile-function-environment nil)
 		(byte-compile-bound-variables nil)
+		(byte-compile-const-variables nil)
 		(byte-compile-free-references nil)
 		(byte-compile-free-assignments nil)
 		;;
@@ -1418,8 +1469,11 @@ recompile every `.el' file that already has a `.elc' file."
     (save-some-buffers)
     (force-mode-line-update))
   (save-current-buffer
-    (byte-goto-log-buffer)
-    (setq default-directory directory)
+    (set-buffer (get-buffer-create "*Compile-Log*"))
+    (setq default-directory (expand-file-name directory))
+    ;; compilation-mode copies value of default-directory.
+    (unless (eq major-mode 'compilation-mode)
+      (compilation-mode))
     (let ((directories (list (expand-file-name directory)))
 	  (default-directory default-directory)
 	  (skip-count 0)
@@ -1435,7 +1489,8 @@ recompile every `.el' file that already has a `.elc' file."
 	       source dest)
 	   (dolist (file files)
 	     (setq source (expand-file-name file directory))
-	     (if (and (not (member file '("." ".." "RCS" "CVS")))
+	     (if (and (not (member file '("RCS" "CVS")))
+		      (not (eq ?\. (aref file 0)))
 		      (file-directory-p source)
 		      (not (file-symlink-p source)))
 		 ;; This file is a subdirectory.  Handle them differently.
@@ -1533,8 +1588,8 @@ The value is non-nil if there were no errors, nil if errors."
       ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
       (set-buffer-multibyte t)
       (insert-file-contents filename)
-      ;; Mimic the way after-insert-file-set-buffer-file-coding-system
-      ;; can make the buffer unibyte when visiting this file.
+      ;; 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)
 		(eq (coding-system-type last-coding-system-used) 5))
 	;; For coding systems no-conversion and raw-text...,
@@ -1553,11 +1608,14 @@ The value is non-nil if there were no errors, nil if errors."
     ;; 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)
-		   (with-current-buffer input-buffer no-byte-compile))
-	  (if (file-exists-p target-file)
-	      (condition-case nil (delete-file target-file) (error nil)))
+	  ;; (message "%s not compiled because of `no-byte-compile: %s'"
+	  ;; 	   (file-relative-name filename)
+	  ;; 	   (with-current-buffer input-buffer no-byte-compile))
+	  (when (file-exists-p target-file)
+	    (message "%s deleted because of `no-byte-compile: %s'"
+		     (file-relative-name target-file)
+		     (buffer-local-value 'no-byte-compile input-buffer))
+	    (condition-case nil (delete-file target-file) (error nil)))
 	  ;; We successfully didn't compile this file.
 	  'no-byte-compile)
       (when byte-compile-verbose
@@ -1634,7 +1692,7 @@ The value is non-nil if there were no errors, nil if errors."
 ;;;###autoload
 (defun compile-defun (&optional arg)
   "Compile and evaluate the current top-level form.
-Print the result in the minibuffer.
+Print the result in the echo area.
 With argument, insert value in current buffer after the form."
   (interactive "P")
   (save-excursion
@@ -1721,6 +1779,9 @@ With argument, insert value in current buffer after the form."
 	    (byte-compile-file-form form)))
 	;; Compile pending forms at end of file.
 	(byte-compile-flush-pending)
+	;; Make warnings about unresolved functions
+	;; give the end of the file as their position.
+	(setq byte-compile-last-position (point-max))
 	(byte-compile-warn-about-unresolved-functions)
 	;; Should we always do this?  When calling multiple files, it
 	;; would be useful to delay this warning until all have
@@ -1732,8 +1793,7 @@ With argument, insert value in current buffer after the form."
     outbuffer))
 
 (defun byte-compile-fix-header (filename inbuffer outbuffer)
-  (save-excursion
-    (set-buffer outbuffer)
+  (with-current-buffer outbuffer
     ;; See if the buffer has any multibyte characters.
     (when (< (point-max) (position-bytes (point-max)))
       (when (byte-compile-version-cond byte-compile-compatibility)
@@ -1796,10 +1856,7 @@ With argument, insert value in current buffer after the form."
 	    " on "
 	    (current-time-string) "\n;;; from file " filename "\n")
     (insert ";;; in Emacs version " emacs-version "\n")
-    (insert ";;; with bytecomp version "
-	    (progn (string-match "[0-9.]+" byte-compile-version)
-		   (match-string 0 byte-compile-version))
-	    "\n;;; "
+    (insert ";;; "
 	    (cond
 	     ((eq byte-optimize 'source) "with source-level optimization only")
 	     ((eq byte-optimize 'byte) "with byte-level optimization only")
@@ -1877,6 +1934,8 @@ With argument, insert value in current buffer after the form."
       (prin1 form outbuffer)
       nil)))
 
+(defvar print-gensym-alist)		;Used before print-circle existed.
+
 (defun byte-compile-output-docform (preface name info form specindex quoted)
   "Print a form with a doc string.  INFO is (prefix doc-index postfix).
 If PREFACE and NAME are non-nil, print them too,
@@ -1927,8 +1986,7 @@ list that represents a doc string reference.
 	       ;; print-gensym-alist not to be cleared
 	       ;; between calls to print functions.
 	       (print-gensym '(t))
-	       ;; print-gensym-alist was used before print-circle existed.
-	       print-gensym-alist
+	       print-gensym-alist    ; was used before print-circle existed.
 	       (print-continuous-numbering t)
 	       print-number-table
 	       (index 0))
@@ -2022,10 +2080,10 @@ list that represents a doc string reference.
 
 (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
 (defun byte-compile-file-form-defsubst (form)
-  (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
-	 (setq byte-compile-current-form (nth 1 form))
-	 (byte-compile-warn "defsubst %s was used before it was defined"
-			    (nth 1 form))))
+  (when (assq (nth 1 form) byte-compile-unresolved-functions)
+    (setq byte-compile-current-form (nth 1 form))
+    (byte-compile-warn "defsubst %s was used before it was defined"
+		       (nth 1 form)))
   (byte-compile-file-form
    (macroexpand form byte-compile-macro-environment))
   ;; Return nil so the form is not output twice.
@@ -2058,9 +2116,10 @@ list that represents a doc string reference.
       ;; Since there is no doc string, we can compile this as a normal form,
       ;; and not do a file-boundary.
       (byte-compile-keep-pending form)
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons (nth 1 form) byte-compile-bound-variables)))
+    (when (memq 'free-vars byte-compile-warnings)
+      (push (nth 1 form) byte-compile-bound-variables)
+      (if (eq (car form) 'defconst)
+	  (push (nth 1 form) byte-compile-const-variables)))
     (cond ((consp (nth 2 form))
 	   (setq form (copy-sequence form))
 	   (setcar (cdr (cdr form))
@@ -2070,9 +2129,8 @@ list that represents a doc string reference.
 (put 'custom-declare-variable 'byte-hunk-handler
      'byte-compile-file-form-custom-declare-variable)
 (defun byte-compile-file-form-custom-declare-variable (form)
-  (if (memq 'free-vars byte-compile-warnings)
-      (setq byte-compile-bound-variables
-	    (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+  (when (memq 'free-vars byte-compile-warnings)
+    (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
   (let ((tail (nthcdr 4 form)))
     (while tail
       ;; If there are any (function (lambda ...)) expressions, compile
@@ -2378,8 +2436,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(when (symbolp arg)
 	  (byte-compile-set-symbol-position arg))
 	(cond ((or (not (symbolp arg))
-		   (keywordp arg)
-		   (memq arg '(t nil)))
+		   (byte-compile-const-symbol-p arg t))
 	       (error "Invalid lambda variable %s" arg))
 	      ((eq arg '&rest)
 	       (unless (cdr list)
@@ -2417,30 +2474,35 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 		    (if (cdr body)
 			(setq body (cdr body))))))
 	 (int (assq 'interactive body)))
-    (cond (int
-	   (byte-compile-set-symbol-position 'interactive)
-	   ;; Skip (interactive) if it is in front (the most usual location).
-	   (if (eq int (car body))
-	       (setq body (cdr body)))
-	   (cond ((consp (cdr int))
-		  (if (cdr (cdr int))
-		      (byte-compile-warn "malformed interactive spec: %s"
-					 (prin1-to-string int)))
-		  ;; If the interactive spec is a call to `list',
-		  ;; don't compile it, because `call-interactively'
-		  ;; looks at the args of `list'.
-		  (let ((form (nth 1 int)))
-		    (while (memq (car-safe form) '(let let* progn save-excursion))
-		      (while (consp (cdr form))
-			(setq form (cdr form)))
-		      (setq form (car form)))
-		    (or (eq (car-safe form) 'list)
-			(setq int (list 'interactive
-					(byte-compile-top-level (nth 1 int)))))))
-		 ((cdr int)
-		  (byte-compile-warn "malformed interactive spec: %s"
-				     (prin1-to-string int))))))
+    ;; Process the interactive spec.
+    (when int
+      (byte-compile-set-symbol-position 'interactive)
+      ;; Skip (interactive) if it is in front (the most usual location).
+      (if (eq int (car body))
+	  (setq body (cdr body)))
+      (cond ((consp (cdr int))
+	     (if (cdr (cdr int))
+		 (byte-compile-warn "malformed interactive spec: %s"
+				    (prin1-to-string int)))
+	     ;; If the interactive spec is a call to `list', don't
+	     ;; compile it, because `call-interactively' looks at the
+	     ;; args of `list'.  Actually, compile it to get warnings,
+	     ;; but don't use the result.
+	     (let ((form (nth 1 int)))
+	       (while (memq (car-safe form) '(let let* progn save-excursion))
+		 (while (consp (cdr form))
+		   (setq form (cdr form)))
+		 (setq form (car form)))
+	       (if (eq (car-safe form) 'list)
+		   (byte-compile-top-level (nth 1 int))
+		 (setq int (list 'interactive
+				 (byte-compile-top-level (nth 1 int)))))))
+	    ((cdr int)
+	     (byte-compile-warn "malformed interactive spec: %s"
+				(prin1-to-string int)))))
+    ;; Process the body.
     (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
+      ;; Build the actual byte-coded function.
       (if (and (eq 'byte-code (car-safe compiled))
 	       (not (byte-compile-version-cond
 		     byte-compile-compatibility)))
@@ -2671,14 +2733,17 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-variable-ref (base-op var)
   (when (symbolp var)
     (byte-compile-set-symbol-position var))
-  (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
-      (byte-compile-warn (if (eq base-op 'byte-varbind)
-			     "attempt to let-bind %s %s"
-			   "variable reference to %s %s")
-			 (if (symbolp var) "constant" "nonvariable")
-			 (prin1-to-string var))
+  (if (or (not (symbolp var))
+	  (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
+      (byte-compile-warn
+       (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s %s")
+	     ((eq base-op 'byte-varset) "variable assignment to %s %s")
+	     (t "variable reference to %s %s"))
+       (if (symbolp var) "constant" "nonvariable")
+       (prin1-to-string var))
     (if (and (get var 'byte-obsolete-variable)
-	     (memq 'obsolete byte-compile-warnings))
+	     (memq 'obsolete byte-compile-warnings)
+	     (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
@@ -2688,30 +2753,28 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 			       (format "use %s instead." (car ob))))))
     (if (memq 'free-vars byte-compile-warnings)
 	(if (eq base-op 'byte-varbind)
-	    (setq byte-compile-bound-variables
-		  (cons var byte-compile-bound-variables))
+	    (push var byte-compile-bound-variables)
 	  (or (boundp var)
 	      (memq var byte-compile-bound-variables)
 	      (if (eq base-op 'byte-varset)
 		  (or (memq var byte-compile-free-assignments)
 		      (progn
 			(byte-compile-warn "assignment to free variable %s" var)
-			(setq byte-compile-free-assignments
-			      (cons var byte-compile-free-assignments))))
+			(push var byte-compile-free-assignments)))
 		(or (memq var byte-compile-free-references)
 		    (progn
 		      (byte-compile-warn "reference to free variable %s" var)
-		      (setq byte-compile-free-references
-			    (cons var byte-compile-free-references)))))))))
+		      (push var byte-compile-free-references))))))))
   (let ((tmp (assq var byte-compile-variables)))
-    (or tmp
-	(setq tmp (list var)
-	      byte-compile-variables (cons tmp byte-compile-variables)))
+    (unless tmp
+      (setq tmp (list var))
+      (push tmp byte-compile-variables))
     (byte-compile-out base-op tmp)))
 
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
-	   (assoc ,const byte-compile-constants)
+	   (assoc-default ,const byte-compile-constants
+			  'equal-including-properties nil)
 	 (assq ,const byte-compile-constants))
        (car (setq byte-compile-constants
 		  (cons (list ,const) byte-compile-constants)))))
@@ -2739,6 +2802,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   ;; If function is a symbol, then the variable "byte-SYMBOL" must name
   ;; the opcode to be used.  If function is a list, the first element
   ;; is the function and the second element is the bytecode-symbol.
+  ;; The second element may be nil, meaning there is no opcode.
   ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
   ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
   ;; If it is nil, then the handler is "byte-compile-SYMBOL."
@@ -2970,10 +3034,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(setq args (cdr args))
 	(or args (setq args '(0)
 		       opcode (get '+ 'byte-opcode)))
-	(while args
-	  (byte-compile-form (car args))
-	  (byte-compile-out opcode 0)
-	  (setq args (cdr args))))
+	(dolist (arg args)
+	  (byte-compile-form arg)
+	  (byte-compile-out opcode 0)))
     (byte-compile-constant (eval form))))
 
 
@@ -3236,51 +3299,55 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
     ,tag))
 
+(defmacro byte-compile-maybe-guarded (condition &rest body)
+  "Execute forms in BODY, potentially guarded by CONDITION.
+CONDITION is the test in an `if' form or in a `cond' clause.
+BODY is to compile the first arm of the if or the body of the
+cond clause.  If CONDITION is of the form `(foundp 'foo)'
+or `(boundp 'foo)', the relevant warnings from BODY about foo
+being undefined will be suppressed."
+  (declare (indent 1) (debug t))
+  `(let* ((fbound
+	   (if (eq 'fboundp (car-safe ,condition))
+	       (and (eq 'quote (car-safe (nth 1 ,condition)))
+		    ;; Ignore if the symbol is already on the
+		    ;; unresolved list.
+		    (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
+			       byte-compile-unresolved-functions))
+		    (nth 1 (nth 1 ,condition)))))
+	  (bound (if (or (eq 'boundp (car-safe ,condition))
+			 (eq 'default-boundp (car-safe ,condition)))
+		     (and (eq 'quote (car-safe (nth 1 ,condition)))
+			  (nth 1 (nth 1 ,condition)))))
+	  ;; Maybe add to the bound list.
+	  (byte-compile-bound-variables
+	   (if bound
+	       (cons bound byte-compile-bound-variables)
+	     byte-compile-bound-variables)))
+     (progn ,@body)
+     ;; Maybe remove the function symbol from the unresolved list.
+     (if fbound
+	 (setq byte-compile-unresolved-functions
+	       (delq (assq fbound byte-compile-unresolved-functions)
+		     byte-compile-unresolved-functions)))))
+
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
   ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
   ;; and avoid warnings about the relevent symbols in the consequent.
-  (let* ((clause (nth 1 form))
-	 (fbound (if (eq 'fboundp (car-safe clause))
-		     (and (eq 'quote (car-safe (nth 1 clause)))
-			  ;; Ignore if the symbol is already on the
-			  ;; unresolved list.
-			  (not (assq
-				(nth 1 (nth 1 clause)) ; the relevant symbol
-				byte-compile-unresolved-functions))
-			  (nth 1 (nth 1 clause)))))
-	 (bound (if (eq 'boundp (car-safe clause))
-		    (and (eq 'quote (car-safe (nth 1 clause)))
-			 (nth 1 (nth 1 clause)))))
-	 (donetag (byte-compile-make-tag)))
+  (let ((clause (nth 1 form))
+	(donetag (byte-compile-make-tag)))
     (if (null (nthcdr 3 form))
 	;; No else-forms
 	(progn
 	  (byte-compile-goto-if nil for-effect donetag)
-	  ;; Maybe add to the bound list.
-	  (let ((byte-compile-bound-variables
-		 (if bound
-		     (cons bound byte-compile-bound-variables)
-		   byte-compile-bound-variables)))
+	  (byte-compile-maybe-guarded clause
 	    (byte-compile-form (nth 2 form) for-effect))
-	  ;; Maybe remove the function symbol from the unresolved list.
-	  (if fbound
-	      (setq byte-compile-unresolved-functions
-		    (delq (assq fbound byte-compile-unresolved-functions)
-			  byte-compile-unresolved-functions)))
 	  (byte-compile-out-tag donetag))
       (let ((elsetag (byte-compile-make-tag)))
 	(byte-compile-goto 'byte-goto-if-nil elsetag)
-	;; As above for the first form.
-	(let ((byte-compile-bound-variables
-		 (if bound
-		     (cons bound byte-compile-bound-variables)
-		   byte-compile-bound-variables)))
-	    (byte-compile-form (nth 2 form) for-effect))
-	(if fbound
-	    (setq byte-compile-unresolved-functions
-		  (delq (assq fbound byte-compile-unresolved-functions)
-			byte-compile-unresolved-functions)))
+	(byte-compile-maybe-guarded clause
+	  (byte-compile-form (nth 2 form) for-effect))
 	(byte-compile-goto 'byte-goto donetag)
 	(byte-compile-out-tag elsetag)
 	(byte-compile-body (cdr (cdr (cdr form))) for-effect)
@@ -3303,17 +3370,20 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	     (if (null (cdr clause))
 		 ;; First clause is a singleton.
 		 (byte-compile-goto-if t for-effect donetag)
-	       (setq nexttag (byte-compile-make-tag))
-	       (byte-compile-goto 'byte-goto-if-nil nexttag)
-	       (byte-compile-body (cdr clause) for-effect)
-	       (byte-compile-goto 'byte-goto donetag)
-	       (byte-compile-out-tag nexttag)))))
+		 (setq nexttag (byte-compile-make-tag))
+		 (byte-compile-goto 'byte-goto-if-nil nexttag)
+		 (byte-compile-maybe-guarded (car clause)
+		   (byte-compile-body (cdr clause) for-effect))
+		 (byte-compile-goto 'byte-goto donetag)
+		 (byte-compile-out-tag nexttag)))))
     ;; Last clause
-    (and (cdr clause) (not (eq (car clause) t))
-	 (progn (byte-compile-form (car clause))
-		(byte-compile-goto-if nil for-effect donetag)
-		(setq clause (cdr clause))))
-    (byte-compile-body-do-effect clause)
+    (let ((guard (car clause)))
+      (and (cdr clause) (not (eq guard t))
+	   (progn (byte-compile-form guard)
+		  (byte-compile-goto-if nil for-effect donetag)
+		  (setq clause (cdr clause))))
+      (byte-compile-maybe-guarded guard
+	(byte-compile-body-do-effect clause)))
     (byte-compile-out-tag donetag)))
 
 (defun byte-compile-and (form)
@@ -3359,31 +3429,26 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-let (form)
   ;; First compute the binding values in the old scope.
   (let ((varlist (car (cdr form))))
-    (while varlist
-      (if (consp (car varlist))
-	  (byte-compile-form (car (cdr (car varlist))))
-	(byte-compile-push-constant nil))
-      (setq varlist (cdr varlist))))
+    (dolist (var varlist)
+      (if (consp var)
+	  (byte-compile-form (car (cdr var)))
+	(byte-compile-push-constant nil))))
   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
 	(varlist (reverse (car (cdr form)))))
-    (while varlist
-      (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
-						   (car (car varlist))
-						 (car varlist)))
-      (setq varlist (cdr varlist)))
+    (dolist (var varlist)
+      (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 
 (defun byte-compile-let* (form)
   (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
 	(varlist (copy-sequence (car (cdr form)))))
-    (while varlist
-      (if (atom (car varlist))
+    (dolist (var varlist)
+      (if (atom var)
 	  (byte-compile-push-constant nil)
-	(byte-compile-form (car (cdr (car varlist))))
-	(setcar varlist (car (car varlist))))
-      (byte-compile-variable-ref 'byte-varbind (car varlist))
-      (setq varlist (cdr varlist)))
+	(byte-compile-form (car (cdr var)))
+	(setq var (car var)))
+      (byte-compile-variable-ref 'byte-varbind var))
     (byte-compile-body-do-effect (cdr (cdr form)))
     (byte-compile-out 'byte-unbind (length (car (cdr form))))))
 
@@ -3437,12 +3502,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defun byte-compile-track-mouse (form)
   (byte-compile-form
-   (list
-    'funcall
-    (list 'quote
-	  (list 'lambda nil
-		(cons 'track-mouse
-		      (byte-compile-top-level-body (cdr form))))))))
+   `(funcall '(lambda nil
+		(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
 
 (defun byte-compile-condition-case (form)
   (let* ((var (nth 1 form))
@@ -3514,7 +3575,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (byte-compile-out 'byte-temp-output-buffer-setup 0)
   (byte-compile-body (cdr (cdr form)))
   (byte-compile-out 'byte-temp-output-buffer-show 0))
-
 
 ;;; top-level forms elsewhere
 
@@ -3532,11 +3592,22 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
-  (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
-   (list 'fset (list 'quote (nth 1 form))
-	 (byte-compile-byte-code-maker
-	  (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
-  (byte-compile-discard)
+  (if (byte-compile-version-cond byte-compile-compatibility)
+      (progn
+	(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
+	 (list 'fset
+	       (list 'quote (nth 1 form))
+	       (byte-compile-byte-code-maker
+		(byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+	(byte-compile-discard))
+    ;; We prefer to generate a defalias form so it will record the function
+    ;; definition just like interpreting a defun.
+    (byte-compile-form
+     (list 'defalias
+	   (list 'quote (nth 1 form))
+	   (byte-compile-byte-code-maker
+	    (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
+     t))
   (byte-compile-constant (nth 1 form)))
 
 (defun byte-compile-defmacro (form)
@@ -3558,13 +3629,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(value (nth 2 form))
 	(string (nth 3 form)))
     (byte-compile-set-symbol-position fun)
-    (when (> (length form) 4)
-      (byte-compile-warn
-       "%s %s called with %d arguments, but accepts only %s"
-       fun var (length (cdr form)) 3))
+    (when (or (> (length form) 4)
+	      (and (eq fun 'defconst) (null (cddr form))))
+      (let ((ncall (length (cdr form))))
+	(byte-compile-warn
+	 "%s called with %d argument%s, but %s %s"
+	 fun ncall
+	 (if (= 1 ncall) "" "s")
+	 (if (< ncall 2) "requires" "accepts only")
+	 "2-3")))
     (when (memq 'free-vars byte-compile-warnings)
-      (setq byte-compile-bound-variables
-	    (cons var byte-compile-bound-variables)))
+      (push var byte-compile-bound-variables)
+      (if (eq fun 'defconst)
+	  (push var byte-compile-const-variables)))
     (byte-compile-body-do-effect
      (list
       ;; Put the defined variable in this library's load-history entry
@@ -3577,13 +3654,17 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 			     fun var string))
 	`(put ',var 'variable-documentation ,string))
       (if (cddr form)		; `value' provided
-	  (if (eq fun 'defconst)
-	      ;; `defconst' sets `var' unconditionally.
-	      (let ((tmp (make-symbol "defconst-tmp-var")))
-		`(let ((,tmp ,value))
-		   (eval '(defconst ,var ,tmp))))
-	    ;; `defvar' sets `var' only when unbound.
-	    `(if (not (boundp ',var)) (setq ,var ,value))))
+	  (let ((byte-compile-not-obsolete-var var))
+	    (if (eq fun 'defconst)
+		;; `defconst' sets `var' unconditionally.
+		(let ((tmp (make-symbol "defconst-tmp-var")))
+		  `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
+			    ,value))
+	      ;; `defvar' sets `var' only when unbound.
+	      `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
+	(when (eq fun 'defconst)
+	  ;; This will signal an appropriate error at runtime.
+	  `(eval ',form)))
       `',var))))
 
 (defun byte-compile-autoload (form)
@@ -3616,8 +3697,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	   (consp (cdr (nth 2 form)))
 	   (symbolp (nth 1 (nth 2 form))))
       (progn
-	(byte-compile-defalias-warn (nth 1 (nth 1 form))
-				    (nth 1 (nth 2 form)))
+	(byte-compile-defalias-warn (nth 1 (nth 1 form)))
 	(setq byte-compile-function-environment
 	      (cons (cons (nth 1 (nth 1 form))
 			  (nth 1 (nth 2 form)))
@@ -3627,11 +3707,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Turn off warnings about prior calls to the function being defalias'd.
 ;; This could be smarter and compare those calls with
 ;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new alias)
+(defun byte-compile-defalias-warn (new)
   (let ((calls (assq new byte-compile-unresolved-functions)))
     (if calls
 	(setq byte-compile-unresolved-functions
 	      (delq calls byte-compile-unresolved-functions)))))
+
+(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
+(defun byte-compile-no-warnings (form)
+  (let (byte-compile-warnings)
+    (byte-compile-form (cadr form))))
 
 ;;; tags
 
@@ -3654,7 +3739,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (setcdr (cdr tag) byte-compile-depth)))
 
 (defun byte-compile-goto (opcode tag)
-  (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
+  (push (cons opcode tag) byte-compile-output)
   (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
 			(1- byte-compile-depth)
 		      byte-compile-depth))
@@ -3662,7 +3747,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 				(1- byte-compile-depth))))
 
 (defun byte-compile-out (opcode offset)
-  (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
+  (push (cons opcode offset) byte-compile-output)
   (cond ((eq opcode 'byte-call)
 	 (setq byte-compile-depth (- byte-compile-depth offset)))
 	((eq opcode 'byte-return)
@@ -3946,8 +4031,8 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
 
 ;;; report metering (see the hacks in bytecode.c)
 
+(defvar byte-code-meter)
 (defun byte-compile-report-ops ()
-  (defvar byte-code-meter)
   (with-output-to-temp-buffer "*Meter*"
     (set-buffer "*Meter*")
     (let ((i 0) n op off)
@@ -3996,4 +4081,5 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
 
 (run-hooks 'bytecomp-load-hook)
 
+;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
 ;;; bytecomp.el ends here