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

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 296265618b..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.122 $")
-
 ;; 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)
@@ -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.
@@ -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.
@@ -441,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.
@@ -773,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)
@@ -791,17 +797,17 @@ 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 (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 (cdr s) old-autoloads))))))))))
 
@@ -926,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)))
@@ -949,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)))
@@ -972,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*")))
 
@@ -1163,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.
@@ -1180,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)
@@ -1247,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
@@ -1261,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)
@@ -1315,13 +1360,13 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   nil)
 
 
-(defsubst byte-compile-const-symbol-p (symbol &optional value)
+(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
   "Non-nil if SYMBOL is constant.
-If VALUE is nil, only return non-nil if the value of the symbol is the
+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)
-      (if value (memq symbol byte-compile-const-variables))))
+      (if any-value (memq symbol byte-compile-const-variables))))
 
 (defmacro byte-compile-constp (form)
   "Return non-nil if FORM is a constant."
@@ -1424,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)
+    (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)
@@ -1441,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.
@@ -1539,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...,
@@ -1559,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
@@ -1640,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
@@ -1727,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
@@ -1801,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")
@@ -2065,7 +2117,7 @@ list that represents a doc string reference.
       ;; and not do a file-boundary.
       (byte-compile-keep-pending form)
     (when (memq 'free-vars byte-compile-warnings)
-      (push (nth 1 form) byte-compile-dynamic-variables)
+      (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))
@@ -2432,17 +2484,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	     (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'.
+	     ;; 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)))
-	       (or (eq (car-safe form) 'list)
-		   (setq int (list 'interactive
-				   (byte-compile-top-level (nth 1 int)))))))
+	       (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)))))
@@ -2688,7 +2742,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
        (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
@@ -2718,7 +2773,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (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)))))
@@ -2746,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."
@@ -3242,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)
@@ -3309,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)
@@ -3511,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
 
@@ -3529,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)
@@ -3557,11 +3631,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (byte-compile-set-symbol-position fun)
     (when (or (> (length form) 4)
 	      (and (eq fun 'defconst) (null (cddr form))))
-      (byte-compile-warn
-       "%s called with %d arguments, but accepts only %s"
-       fun (length (cdr form)) "2-3"))
+      (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)
-      (push var byte-compile-dynamic-variables)
+      (push var byte-compile-bound-variables)
       (if (eq fun 'defconst)
 	  (push var byte-compile-const-variables)))
     (byte-compile-body-do-effect
@@ -3576,13 +3654,14 @@ 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")))
-		`(funcall '(lambda (,tmp) (defconst ,var ,tmp))
-			  ,value))
-	    ;; `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)))
@@ -3633,6 +3712,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (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
 
@@ -3947,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)
@@ -3997,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