X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fbytecomp.el;h=a7bbe8d15254aa5ae650f068ba76bf08988a891a;hb=a3c8db1e07b33da64b3af89f0c8923619e8e1ee4;hp=4e0bd04846e20de83d88bd897da336cc37453a60;hpb=72a705551741d6f85a40eea486c222bac482d8dc;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/bytecomp.el b/lisp/bytecomp.el
index 4e0bd04..a7bbe8d 100644
--- a/lisp/bytecomp.el
+++ b/lisp/bytecomp.el
@@ -3,13 +3,14 @@
 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
 ;;; Copyright (C) 1996 Ben Wing.
 
-;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Authors: Jamie Zawinski <jwz@jwz.org>
 ;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
+;;	Ben Wing <ben@xemacs.org>
+;;	Martin Buchholz <martin@xemacs.org>
+;;	Richard Stallman <rms@gnu.org>
+;; Keywords: internal lisp
 
-;; Subsequently modified by RMS and others.
-
-(defconst byte-compile-version (purecopy  "2.25 XEmacs; 22-Mar-96."))
+(defconst byte-compile-version "2.27 XEmacs; 2000-09-12.")
 
 ;; This file is part of XEmacs.
 
@@ -33,8 +34,15 @@
 ;;; Commentary:
 
 ;; The Emacs Lisp byte compiler.  This crunches lisp source into a
-;; sort of p-code which takes up less space and can be interpreted
-;; faster.  The user entry points are byte-compile-file,
+;; sort of p-code (`bytecode') which takes up less space and can be
+;; interpreted faster.  First, the source code forms are converted to
+;; an intermediate form, `lapcode' [`LAP' == `Lisp Assembly Program']
+;; which is much easier to manipulate than bytecode.  Then the lapcode
+;; is converted to bytecode, which can be considered to be actual
+;; machine language.  Optimizations can occur at either the source
+;; level or the lapcode level.
+
+;; The user entry points are byte-compile-file,
 ;; byte-recompile-directory and byte-compile-buffer.
 
 ;;; Code:
@@ -101,6 +109,8 @@
 ;;;				'unresolved (calls to unknown functions)
 ;;;				'callargs  (lambda calls with args that don't
 ;;;					    match the lambda's definition)
+;;;				'subr-callargs (calls to subrs with args that
+;;;					    don't match the subr's definition)
 ;;;				'redefine  (function cell redefined from
 ;;;					    a macro to a lambda or vice versa,
 ;;;					    or redefined to take other args)
@@ -111,7 +121,7 @@
 ;;;				generate .elc files which can be loaded into
 ;;;				generic emacs 19.
 ;;; emacs-lisp-file-regexp	Regexp for the extension of source-files;
-;;;				see also the function byte-compile-dest-file.
+;;;				see also the function `byte-compile-dest-file'.
 ;;; byte-compile-overwrite-file	If nil, delete old .elc files before saving.
 ;;;
 ;;; Most of the above parameters can also be set on a file-by-file basis; see
@@ -135,7 +145,7 @@
 ;;;	This is, in fact, exactly what `defsubst' does.  To make a function no
 ;;;	longer be inline, you must use `proclaim-notinline'.  Beware that if
 ;;;	you define a function with `defsubst' and later redefine it with
-;;;	`defun', it will still be open-coded until you use proclaim-notinline.
+;;;	`defun', it will still be open-coded until you use `proclaim-notinline'.
 ;;;
 ;;;  o	You can also open-code one particular call to a function without
 ;;;	open-coding all calls.  Use the 'inline' form to do this, like so:
@@ -154,24 +164,24 @@
 ;;;
 ;;;  o  Forms like ((lambda ...) ...) are open-coded.
 ;;;
-;;;  o  The form `eval-when-compile' is like progn, except that the body
+;;;  o  The form `eval-when-compile' is like `progn', except that the body
 ;;;     is evaluated at compile-time.  When it appears at top-level, this
 ;;;     is analogous to the Common Lisp idiom (eval-when (compile) ...).
 ;;;     When it does not appear at top-level, it is similar to the
 ;;;     Common Lisp #. reader macro (but not in interpreted code).
 ;;;
-;;;  o  The form `eval-and-compile' is similar to eval-when-compile, but
-;;;	the whole form is evalled both at compile-time and at run-time.
+;;;  o  The form `eval-and-compile' is similar to `eval-when-compile',
+;;;     but the whole form is evalled both at compile-time and at run-time.
 ;;;
 ;;;  o  The command M-x byte-compile-and-load-file does what you'd think.
 ;;;
-;;;  o  The command compile-defun is analogous to eval-defun.
+;;;  o  The command `compile-defun' is analogous to `eval-defun'.
 ;;;
-;;;  o  If you run byte-compile-file on a filename which is visited in a
+;;;  o  If you run `byte-compile-file' on a filename which is visited in a
 ;;;     buffer, and that buffer is modified, you are asked whether you want
 ;;;     to save the buffer before compiling.
 ;;;
-;;;  o  You can add this to /etc/magic to make file(1) recognise the files
+;;;  o  You can add this to /etc/magic to make file(1) recognize the files
 ;;;     generated by this compiler:
 ;;;
 ;;;	  0	string		;ELC		GNU Emacs Lisp compiled file,
@@ -210,17 +220,16 @@
 be hard-coded into bytecomp when it compiles itself.  If the compiler itself
 is compiled with optimization, this causes a speedup.")
 
-  (cond (byte-compile-single-version
-	 (defmacro byte-compile-single-version () t)
-	 (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
-	(t
-	 (defmacro byte-compile-single-version () nil)
-	 (defmacro byte-compile-version-cond (cond) cond)))
+  (cond
+   (byte-compile-single-version
+    (defmacro byte-compile-single-version () t)
+    (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
+   (t
+    (defmacro byte-compile-single-version () nil)
+    (defmacro byte-compile-version-cond (cond) cond)))
   )
 
-(defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
-				   (purecopy "\\.EL\\(;[0-9]+\\)?$")
-				 (purecopy "\\.el$"))
+(defvar emacs-lisp-file-regexp "\\.el$"
   "*Regexp which matches Emacs Lisp source files.
 You may want to redefine `byte-compile-dest-file' if you change this.")
 
@@ -234,18 +243,16 @@ You may want to redefine `byte-compile-dest-file' if you change this.")
 	(funcall handler 'byte-compiler-base-file-name filename)
       filename)))
 
-(or (fboundp 'byte-compile-dest-file)
-    ;; The user may want to redefine this along with emacs-lisp-file-regexp,
-    ;; so only define it if it is undefined.
-    (defun byte-compile-dest-file (filename)
-      "Convert an Emacs Lisp source file name to a compiled file name."
-      (setq filename (byte-compiler-base-file-name filename))
-      (setq filename (file-name-sans-versions filename))
-      (cond ((eq system-type 'vax-vms)
-		 (concat (substring filename 0 (string-match ";" filename)) "c"))
-		((string-match emacs-lisp-file-regexp filename)
-		 (concat (substring filename 0 (match-beginning 0)) ".elc"))
-		(t (concat filename ".elc")))))
+(unless (fboundp 'byte-compile-dest-file)
+  ;; The user may want to redefine this along with emacs-lisp-file-regexp,
+  ;; so only define it if it is undefined.
+  (defun byte-compile-dest-file (filename)
+    "Convert an Emacs Lisp source file name to a compiled file name."
+    (setq filename (byte-compiler-base-file-name filename))
+    (setq filename (file-name-sans-versions filename))
+    (if (string-match emacs-lisp-file-regexp filename)
+	(concat (substring filename 0 (match-beginning 0)) ".elc")
+      (concat filename ".elc"))))
 
 ;; This can be the 'byte-compile property of any symbol.
 (autoload 'byte-compile-inline-expand "byte-optimize")
@@ -260,7 +267,7 @@ You may want to redefine `byte-compile-dest-file' if you change this.")
 ;; disassembler.  The disassembler just requires 'byte-compile, but
 ;; that doesn't define this function, so this seems to be a reasonable
 ;; thing to do.
-(autoload 'byte-decompile-bytecode "byte-opt")
+(autoload 'byte-decompile-bytecode "byte-optimize")
 
 (defvar byte-compile-verbose
   (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
@@ -350,7 +357,7 @@ If it is 'byte, then only byte-level optimizations will be logged.")
 
 ;; byte-compile-warning-types in FSF.
 (defvar byte-compile-default-warnings
-  '(redefine callargs free-vars unresolved unused-vars obsolete)
+  '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete)
   "*The warnings used when byte-compile-warnings is t.")
 
 (defvar byte-compile-warnings t
@@ -361,6 +368,7 @@ Elements of the list may be:
   unused-vars	references to non-global variables bound but not referenced.
   unresolved	calls to unknown functions.
   callargs	lambda calls with args that don't match the definition.
+  subr-callargs	calls to subrs with args that don't match the definition.
   redefine	function cell redefined from a macro to a lambda or vice
 		versa, or redefined to take a different number of arguments.
   obsolete	use of an obsolete function or variable.
@@ -373,7 +381,7 @@ See also the macro `byte-compiler-options'.")
 
 (defvar byte-compile-generate-call-tree nil
   "*Non-nil means collect call-graph information when compiling.
-This records functions were called and from where.
+This records functions that were called and from where.
 If the value is t, compilation displays the call graph when it finishes.
 If the value is neither t nor nil, compilation asks you whether to display
 the graph.
@@ -435,16 +443,33 @@ on the specbind stack.  The cdr of each cell is an integer bitmask.")
 
 (defvar byte-compiler-error-flag)
 
+;;; A form of eval that includes the currently defined macro definitions.
+;;; This helps implement the promise made in the Lispref:
+;;;
+;;; "If a file being compiled contains a `defmacro' form, the macro is
+;;; defined temporarily for the rest of the compilation of that file."
+(defun byte-compile-eval (form)
+  (let ((save-macro-environment nil))
+    (unwind-protect
+	(loop for (sym . def) in byte-compile-macro-environment do
+	  (push
+	   (if (fboundp sym) (cons sym (symbol-function sym)) sym)
+	   save-macro-environment)
+	  (fset sym (cons 'macro def))
+	  finally return (eval form))
+      (dolist (elt save-macro-environment)
+	(if (symbolp elt)
+	    (fmakunbound elt)
+	  (fset (car elt) (cdr elt)))))))
+
 (defconst byte-compile-initial-macro-environment
-  (purecopy
-   '((byte-compiler-options . (lambda (&rest forms)
-				(apply 'byte-compiler-options-handler forms)))
-     (eval-when-compile . (lambda (&rest body)
-			    (list 'quote (eval (byte-compile-top-level
-						(cons 'progn body))))))
-     (eval-and-compile . (lambda (&rest body)
-			   (eval (cons 'progn body))
-			   (cons 'progn body)))))
+  '((byte-compiler-options . (lambda (&rest forms)
+			       (apply 'byte-compiler-options-handler forms)))
+    (eval-when-compile . (lambda (&rest body)
+			   (list 'quote (byte-compile-eval (cons 'progn body)))))
+    (eval-and-compile . (lambda (&rest body)
+			  (byte-compile-eval (cons 'progn body))
+			  (cons 'progn body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -620,7 +645,7 @@ Each element is (INDEX . VALUE)")
   "to examine top-of-stack, jump and don't pop it if it's nil,
 otherwise pop it")
 (byte-defop 134 -1 byte-goto-if-not-nil-else-pop
-  "to examine top-of-stack, jump and don't pop it if it's non nil,
+  "to examine top-of-stack, jump and don't pop it if it's non-nil,
 otherwise pop it")
 
 (byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
@@ -708,18 +733,18 @@ otherwise pop it")
 (defconst byte-constant-limit 64
   "Exclusive maximum index usable in the `byte-constant' opcode.")
 
-(defconst byte-goto-ops (purecopy
-			 '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-			   byte-goto-if-nil-else-pop
-			   byte-goto-if-not-nil-else-pop))
+(defconst byte-goto-ops
+  '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
+	      byte-goto-if-nil-else-pop
+	      byte-goto-if-not-nil-else-pop)
   "List of byte-codes whose offset is a pc.")
 
 (defconst byte-goto-always-pop-ops
-  (purecopy '(byte-goto-if-nil byte-goto-if-not-nil)))
+  '(byte-goto-if-nil byte-goto-if-not-nil))
 
 (defconst byte-rel-goto-ops
-  (purecopy '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil
-	      byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop))
+  '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil
+		  byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop)
   "byte-codes for relative jumps.")
 
 (byte-extrude-byte-code-vectors)
@@ -770,13 +795,13 @@ otherwise pop it")
 	     (error "Non-symbolic opcode `%s'" op))
 	    ((eq op 'TAG)
 	     (setcar off pc)
-	     (setq patchlist (cons off patchlist)))
+	     (push off patchlist))
 	    ((memq op byte-goto-ops)
 	     (setq pc (+ pc 3))
 	     (setq bytes (cons (cons pc (cdr off))
 			       (cons nil
 				     (cons (symbol-value op) bytes))))
-	     (setq patchlist (cons bytes patchlist)))
+	     (push bytes patchlist))
 	    (t
 	     (setq bytes
 		   (cond ((cond ((consp off)
@@ -859,81 +884,64 @@ otherwise pop it")
 (defvar byte-compile-dest-file nil)
 
 (defmacro byte-compile-log (format-string &rest args)
-  (list 'and
-	'byte-optimize
-	'(memq byte-optimize-log '(t source))
-	(list 'let '((print-escape-newlines t)
-		     (print-level 4)
-		     (print-length 4))
-	      (list 'byte-compile-log-1
-		    (cons 'format
-		      (cons format-string
-			(mapcar
-			 '(lambda (x)
-			    (if (symbolp x) (list 'prin1-to-string x) x))
-			 args)))))))
-
-(defconst byte-compile-last-warned-form nil)
+  `(when (and byte-optimize (memq byte-optimize-log '(t source)))
+      (let ((print-escape-newlines t)
+	    (print-level 4)
+	    (print-length 4))
+	(byte-compile-log-1 (format ,format-string ,@args)))))
+
+(defconst byte-compile-last-warned-form 'nothing)
 
 ;; Log a message STRING in *Compile-Log*.
 ;; Also log the current function and file if not already done.
 (defun byte-compile-log-1 (string &optional fill)
-  (let ((this-form (or byte-compile-current-form "toplevel forms")))
-    (cond
-     (noninteractive
-      (if (or byte-compile-current-file
-	      (and byte-compile-last-warned-form
-		   (not (eq this-form byte-compile-last-warned-form))))
-	  (message
-	   (format "While compiling %s%s:"
-		   this-form
-		   (if byte-compile-current-file
-		       (if (stringp byte-compile-current-file)
-			   (concat " in file " byte-compile-current-file)
-			 (concat " in buffer "
-				 (buffer-name byte-compile-current-file)))
-		     ""))))
-      (message "  %s" string))
-     (t
-      (save-excursion
-	(set-buffer (get-buffer-create "*Compile-Log*"))
+  (let* ((this-form (or byte-compile-current-form "toplevel forms"))
+	 (while-compiling-msg
+	  (when (or byte-compile-current-file
+		    (not (eq this-form byte-compile-last-warned-form)))
+	    (format
+	     "While compiling %s%s:"
+	     this-form
+	     (cond
+	      ((stringp byte-compile-current-file)
+	       (concat " in file " byte-compile-current-file))
+	      ((bufferp byte-compile-current-file)
+	       (concat " in buffer "
+		       (buffer-name byte-compile-current-file)))
+	      (""))))))
+    (if noninteractive
+	(progn
+	  (when while-compiling-msg (message "%s" while-compiling-msg))
+	  (message "  %s" string))
+      (with-current-buffer (get-buffer-create "*Compile-Log*")
 	(goto-char (point-max))
-	(cond ((or byte-compile-current-file
-		   (and byte-compile-last-warned-form
-			(not (eq this-form byte-compile-last-warned-form))))
-	       (if byte-compile-current-file
-		   (insert "\n\^L\n" (current-time-string) "\n"))
-	       (insert "While compiling "
-		       (if (stringp this-form) this-form
-			 (format "%s" this-form)))
-	       (if byte-compile-current-file
-		   (if (stringp byte-compile-current-file)
-		       (insert " in file " byte-compile-current-file)
-		     (insert " in buffer "
-			     (buffer-name byte-compile-current-file))))
-	       (insert ":\n")))
+	(when byte-compile-current-file
+	  (when (> (point-max) (point-min))
+	    (insert "\n\^L\n"))
+	  (insert (current-time-string) "\n"))
+	(when while-compiling-msg (insert while-compiling-msg "\n"))
 	(insert "  " string "\n")
-	(if (and fill (not (string-match "\n" string)))
-	    (let ((fill-prefix "     ")
-		  (fill-column 78))
-	      (fill-paragraph nil)))
-	)))
-    (setq byte-compile-current-file nil
-	  byte-compile-last-warned-form this-form)))
+	(when (and fill (not (string-match "\n" string)))
+	  (let ((fill-prefix "     ")
+		(fill-column 78))
+	    (fill-paragraph nil)))))
+    (setq byte-compile-current-file nil)
+    (setq byte-compile-last-warned-form this-form)))
 
 ;; Log the start of a file in *Compile-Log*, and mark it as done.
 ;; But do nothing in batch mode.
 (defun byte-compile-log-file ()
-  (and byte-compile-current-file (not noninteractive)
-       (save-excursion
-	 (set-buffer (get-buffer-create "*Compile-Log*"))
-	 (goto-char (point-max))
-	 (insert "\n\^L\nCompiling "
-		 (if (stringp byte-compile-current-file)
-		     (concat "file " byte-compile-current-file)
-		   (concat "buffer " (buffer-name byte-compile-current-file)))
-		 " at " (current-time-string) "\n")
-	 (setq byte-compile-current-file nil))))
+  (when (and byte-compile-current-file (not noninteractive))
+    (with-current-buffer (get-buffer-create "*Compile-Log*")
+      (when (> (point-max) (point-min))
+	(goto-char (point-max))
+	(insert "\n\^L\n"))
+      (insert "Compiling "
+	      (if (stringp byte-compile-current-file)
+		  (concat "file " byte-compile-current-file)
+		(concat "buffer " (buffer-name byte-compile-current-file)))
+	      " at " (current-time-string) "\n")
+      (setq byte-compile-current-file nil))))
 
 (defun byte-compile-warn (format &rest args)
   (setq format (apply 'format format args))
@@ -955,7 +963,9 @@ otherwise pop it")
    (concat "!! "
 	   (format (if (cdr error-info) "%s (%s)" "%s")
 		   (get (car error-info) 'error-message)
-		   (prin1-to-string (cdr error-info))))))
+		   (prin1-to-string (cdr error-info)))))
+  (if stack-trace-on-error
+      (backtrace nil t)))
 
 ;;; Used by make-obsolete.
 (defun byte-compile-obsolete (form)
@@ -987,7 +997,7 @@ otherwise pop it")
     (verbose byte-compile-verbose (t nil) val)
     (new-bytecodes byte-compile-new-bytecodes (t nil) val)
     (warnings byte-compile-warnings
-	      ((callargs redefine free-vars unused-vars unresolved))
+	      ((callargs subr-callargs redefine free-vars unused-vars unresolved))
 	      val)))
 
 ;; XEmacs addition
@@ -1004,7 +1014,7 @@ otherwise pop it")
 	      '(emacs19) '(emacs20)))))
 
 ;; now we can copy it.
-(setq byte-compiler-legal-options (purecopy byte-compiler-legal-options))
+(setq byte-compiler-legal-options byte-compiler-legal-options)
 
 (defun byte-compiler-options-handler (&rest args)
   (let (key val desc choices)
@@ -1225,7 +1235,7 @@ otherwise pop it")
   nil)
 
 (defun byte-compile-defvar-p (var)
-  ;; Whether the byte compiler thinks that nonexical references to this
+  ;; Whether the byte compiler thinks that non-lexical references to this
   ;; variable are ok.
   (or (globally-boundp var)
       (let ((rest byte-compile-bound-variables))
@@ -1236,7 +1246,10 @@ otherwise pop it")
 	      (setq var nil))
 	  (setq rest (cdr rest)))
 	;; if var is nil at this point, it's a defvar in this file.
-	(not var))))
+	(not var))
+      ;; Perhaps (eval-when-compile (defvar foo))
+      (and (boundp 'current-load-list)
+	   (memq var current-load-list))))
 
 
 ;;; If we have compiled bindings of variables which have no referents, warn.
@@ -1257,7 +1270,7 @@ otherwise pop it")
 	       ;; have (declare (ignore x)) yet; and second, inline
 	       ;; expansion produces forms like
 	       ;;   ((lambda (arg) (byte-code "..." [arg])) x)
-	       ;; which we can't (ok, well, don't) recognise as
+	       ;; which we can't (ok, well, don't) recognize as
 	       ;; containing a reference to arg, so every inline
 	       ;; expansion would generate a warning.  (If we had
 	       ;; `ignore' then inline expansion could emit an
@@ -1271,16 +1284,18 @@ otherwise pop it")
     (setq unreferenced (nreverse unreferenced))
     (while unreferenced
       (byte-compile-warn
-       (format "variable %s bound but not referenced" (car unreferenced)))
+       "variable %s bound but not referenced" (car unreferenced))
       (setq unreferenced (cdr unreferenced)))))
 
 
+(defmacro byte-compile-constant-symbol-p (symbol)
+  `(or (keywordp ,symbol) (memq ,symbol '(nil t))))
+
 (defmacro byte-compile-constp (form)
   ;; Returns non-nil if FORM is a constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((keywordp (, form)))
-	   ((memq (, form) '(nil t))))))
+  `(cond ((consp ,form) (eq (car ,form) 'quote))
+	 ((symbolp ,form) (byte-compile-constant-symbol-p ,form))
+	 (t)))
 
 (defmacro byte-compile-close-variables (&rest body)
   `(let
@@ -1312,8 +1327,7 @@ otherwise pop it")
 	(byte-compile-warnings (if (eq byte-compile-warnings t)
 				   byte-compile-default-warnings
 				 byte-compile-warnings))
-	(byte-compile-file-domain nil)
-	)
+	(byte-compile-file-domain nil))
      (prog1
 	 (progn ,@body)
        (if (memq 'unused-vars byte-compile-warnings)
@@ -1321,46 +1335,49 @@ otherwise pop it")
 	   (byte-compile-warn-about-unused-variables)))))
 
 
-(defvar byte-compile-warnings-point-max nil)
 (defmacro displaying-byte-compile-warnings (&rest body)
-  `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
-     ;; Log the file name.
+  `(let* ((byte-compile-log-buffer (get-buffer-create "*Compile-Log*"))
+	  (byte-compile-point-max-prev (point-max byte-compile-log-buffer)))
+     ;; Log the file name or buffer name.
      (byte-compile-log-file)
      ;; Record how much is logged now.
      ;; We will display the log buffer if anything more is logged
      ;; before the end of BODY.
-     (or byte-compile-warnings-point-max
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*Compile-Log*"))
-	   (setq byte-compile-warnings-point-max (point-max))))
-     (unwind-protect
-	 (condition-case error-info
-	     (progn ,@body)
-	   (error
-	    (byte-compile-report-error error-info)))
-       (save-excursion
-	 ;; If there were compilation warnings, display them.
-	 (set-buffer "*Compile-Log*")
-	 (if (= byte-compile-warnings-point-max (point-max))
-	     nil
-	   (if temp-buffer-show-function
-	       (let ((show-buffer (get-buffer-create "*Compile-Log-Show*")))
-		 (save-excursion
-		   (set-buffer show-buffer)
-		   (setq buffer-read-only nil)
-		   (erase-buffer))
-		 (copy-to-buffer show-buffer
-				 (save-excursion
-				   (goto-char byte-compile-warnings-point-max)
-				   (forward-line -1)
-				   (point))
-				 (point-max))
-		 (funcall temp-buffer-show-function show-buffer))
-              (select-window
-               (prog1 (selected-window)
-                 (select-window (display-buffer (current-buffer)))
-                 (goto-char byte-compile-warnings-point-max)
-                 (recenter 1)))))))))
+     (defvar byte-compile-warnings-beginning)
+     (let ((byte-compile-warnings-beginning
+	    (if (boundp 'byte-compile-warnings-beginning)
+		byte-compile-warnings-beginning
+	      (point-max byte-compile-log-buffer))))
+
+       (unwind-protect
+	   (call-with-condition-handler
+	       #'(lambda (error-info)
+		   (byte-compile-report-error error-info))
+	       #'(lambda ()
+		   (progn ,@body)))
+	 ;; Always set point in log to start of interesting output.
+	 (with-current-buffer byte-compile-log-buffer
+	   (let ((show-begin
+		  (progn (goto-char byte-compile-point-max-prev)
+			 (skip-chars-forward "\^L\n")
+			 (point))))
+	     ;; If there were compilation warnings, display them.
+	     (if temp-buffer-show-function
+		 (let ((show-buffer (get-buffer-create "*Compile-Log-Show*")))
+		   ;; Always clean show-buffer, even when not displaying it,
+		   ;; so that misleading previous messages aren't left around.
+		   (with-current-buffer show-buffer
+		     (setq buffer-read-only nil)
+		     (erase-buffer))
+		   (copy-to-buffer show-buffer show-begin (point-max))
+		   (when (< byte-compile-warnings-beginning (point-max))
+		     (funcall temp-buffer-show-function show-buffer)))
+	       (when (< byte-compile-warnings-beginning (point-max))
+		 (select-window
+		  (prog1 (selected-window)
+		    (select-window (display-buffer (current-buffer)))
+		    (goto-char show-begin)
+		    (recenter 1)))))))))))
 
 
 ;;;###autoload
@@ -1368,14 +1385,14 @@ otherwise pop it")
   "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
 Files in subdirectories of DIRECTORY are processed also."
   (interactive "DByte force recompile (directory): ")
-  (byte-recompile-directory directory nil t))
+  (byte-recompile-directory directory nil nil t))
 
 ;;;###autoload
 (defun byte-recompile-directory (directory &optional arg norecursion force)
   "Recompile every `.el' file in DIRECTORY that needs recompilation.
 This is if a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of DIRECTORY are processed also unless argument
-NORECURSION is non-nil.
+Files in subdirectories of DIRECTORY are also processed unless
+optional argument NORECURSION is non-nil.
 
 If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
 But a prefix argument (optional second arg) means ask user,
@@ -1384,7 +1401,7 @@ don't ask and compile the file anyway.
 
 A nonzero prefix argument also means ask about each subdirectory.
 
-If the fourth argument FORCE is non-nil,
+If the fourth optional argument FORCE is non-nil,
 recompile every `.el' file that already has a `.elc' file."
   (interactive "DByte recompile directory: \nP")
   (if arg
@@ -1466,8 +1483,6 @@ whether to compile it.  Prefix argument 0 don't ask and recompile anyway."
 			(y-or-n-p (concat "Compile " filename "? "))))))
 	(byte-compile-file filename))))
 
-(defvar kanji-flag nil)
-
 ;;;###autoload
 (defun byte-compile-file (filename &optional load)
   "Compile a file of Lisp code named FILENAME into a file of byte code.
@@ -1503,7 +1518,6 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
       (message "Compiling %s..." filename))
   (let (;;(byte-compile-current-file (file-name-nondirectory filename))
 	(byte-compile-current-file filename)
-	(debug-issue-ebola-notices 0) ; Hack -slb
 	target-file input-buffer output-buffer
 	byte-compile-dest-file)
     (setq target-file (byte-compile-dest-file filename))
@@ -1534,28 +1548,22 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
 	(set-buffer output-buffer)
 	(goto-char (point-max))
 	(insert "\n")			; aaah, unix.
-	(let ((vms-stmlf-recfm t))
-	  (setq target-file (byte-compile-dest-file filename))
-	  (or byte-compile-overwrite-file
-	      (condition-case ()
-		  (delete-file target-file)
-		(error nil)))
-	  (if (file-writable-p target-file)
-	      (let ((kanji-flag nil))	; for nemacs, from Nakagawa Takayuki
-		(if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-		    (setq buffer-file-type t))
-		(write-region 1 (point-max) target-file))
-	    ;; This is just to give a better error message than write-region
-	    (signal 'file-error
-		    (list "Opening output file"
-			  (if (file-exists-p target-file)
-			      "cannot overwrite file"
-			    "directory not writable or nonexistent")
-			  target-file)))
-	  (or byte-compile-overwrite-file
-	      (condition-case ()
-		  (set-file-modes target-file (file-modes filename))
-		(error nil))))
+	(setq target-file (byte-compile-dest-file filename))
+	(unless byte-compile-overwrite-file
+	  (ignore-file-errors (delete-file target-file)))
+	(if (file-writable-p target-file)
+	    (write-region 1 (point-max) target-file)
+	  ;; This is just to give a better error message than write-region
+	  (signal 'file-error
+		  (list "Opening output file"
+			(if (file-exists-p target-file)
+			    "cannot overwrite file"
+			  "directory not writable or nonexistent")
+			target-file)))
+	(or byte-compile-overwrite-file
+	    (condition-case ()
+		(set-file-modes target-file (file-modes filename))
+	      (error nil)))
 	(kill-buffer (current-buffer)))
       (if (and byte-compile-generate-call-tree
 	       (or (eq t byte-compile-generate-call-tree)
@@ -1664,7 +1672,7 @@ With argument, insert value in current buffer after the form."
 
 	;; Compile the forms from the input buffer.
 	(while (progn
-		 (while (progn (skip-chars-forward " \t\n\^l")
+		 (while (progn (skip-chars-forward " \t\n\^L")
 			       (looking-at ";"))
 		   (forward-line 1))
 		 (not (eobp)))
@@ -1765,27 +1773,81 @@ With argument, insert value in current buffer after the form."
   ;; file if under Mule.  If there are any extended characters in the
   ;; input file, use `escape-quoted' to make sure that both binary and
   ;; extended characters are output properly and distinguished properly.
-  ;; Otherwise, use `no-conversion' for maximum portability with non-Mule
+  ;; Otherwise, use `binary' for maximum portability with non-Mule
   ;; Emacsen.
-  (if (featurep 'mule)
-      (if (save-excursion
+  (when (featurep '(or mule file-coding))
+    (defvar buffer-file-coding-system)
+    (let (ces)
+      (if (featurep 'mule)
+	  (save-excursion
 	    (set-buffer byte-compile-inbuffer)
 	    (goto-char (point-min))
 	    ;; mrb- There must be a better way than skip-chars-forward
 	    (skip-chars-forward (concat (char-to-string 0) "-"
 					(char-to-string 255)))
-	    (eq (point) (point-max)))
-	  (setq buffer-file-coding-system 'no-conversion)
-	(insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
-	(setq buffer-file-coding-system 'escape-quoted)
-	;; Lazy loading not yet implemented for MULE files
+	    (if (eq (point) (point-max))
+		(setq ces 'binary)
+	      (goto-char (point-min))
+	      (while (< (point)(point-max))
+		(cond ((and (eq (char-after) ?\;)
+			    (not (eq (char-after (1- (point))) ?\\)))
+		       (delete-region (point)(point-at-eol))
+		       (if (eq (char-after) ?\n)
+			   (delete-char 1)
+			 (forward-char))
+		       )
+		      ((eq (char-after) ?\?)
+		       (forward-char 2)
+		       )
+		      ((eq (char-after) ?\n)
+		       (forward-char)
+		       )
+		      ((eq (char-after) ?\")
+		       (forward-char)
+		       (while (and (< (point)(point-max))
+				   (not (when (eq (char-after) ?\")
+					  (forward-char)
+					  t)))
+			 (if (eq (char-after) ?\\)
+			     (forward-char 2)
+			   (forward-char)))
+		       )
+		      (t
+		       (forward-char))))
+	      (goto-char (point-min))
+	      (skip-chars-forward (concat (char-to-string 0) "-"
+					  (char-to-string 255))))
+	    (setq ces
+		  (if (eq (point) (point-max))
+		      (if (and (featurep 'utf-2000)
+			       (re-search-backward "\\\\u[0-9A-Fa-f]+" nil t))
+			  'utf-8-mcs-unix
+			'binary)
+		    (when (featurep 'utf-2000)
+		      (goto-char (point-min))
+		      (if (re-search-forward "\\\\u[0-9A-Fa-f]+" nil t)
+			  'utf-8-mcs-unix)))))
+	(setq ces 'binary))
+      (if (eq ces 'binary)
+	  (setq buffer-file-coding-system 'binary)
+	(cond ((eq ces 'utf-8-mcs-unix)
+	       (insert
+		"(require 'mule)\n;;;###coding system: utf-8-mcs-unix\n")
+	       (setq buffer-file-coding-system 'utf-8-mcs-unix)
+	       )
+	      (t
+	       (insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
+	       (setq buffer-file-coding-system 'escape-quoted)
+	       ))
+	;; #### Lazy loading not yet implemented for MULE files
 	;; mrb - Fix this someday.
 	(save-excursion
 	  (set-buffer byte-compile-inbuffer)
 	  (setq byte-compile-dynamic nil
 		byte-compile-dynamic-docstrings nil))
-	;;(external-debugging-output (prin1-to-string (buffer-local-variables))))
-	))
+        ;; (external-debugging-output
+        ;;  (prin1-to-string (buffer-local-variables)))
+	)))
   )
 
 
@@ -1904,8 +1966,8 @@ list that represents a doc string reference.
 	     (nthcdr 300 byte-compile-output)
 	     (byte-compile-flush-pending))
 	(funcall handler form)
-	(if for-effect
-	    (byte-compile-discard)))
+	(when for-effect
+	  (byte-compile-discard)))
     (byte-compile-form form t))
   nil)
 
@@ -1939,7 +2001,7 @@ list that represents a doc string reference.
       (byte-compile-file-form form)))))
 
 ;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognise them.  Most other things can be output
+;; so make-docfile can recognize them.  Most other things can be output
 ;; as byte-code.
 
 (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
@@ -1984,7 +2046,7 @@ list that represents a doc string reference.
 	       (while (if (setq form (cdr form))
 			  (byte-compile-constp (car form))))
 	       (null form)))
-	;; eval the macro autoload into the compilation enviroment
+	;; eval the macro autoload into the compilation environment
 	(eval form))
 
     (if name
@@ -2006,12 +2068,14 @@ list that represents a doc string reference.
     ;; No doc string, so we can compile this as a normal form.
     (byte-compile-keep-pending form 'byte-compile-normal-call)))
 
-(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile-file-form-defvar (form)
+(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
+(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
+(defun byte-compile-file-form-defvar-or-defconst (form)
+  ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
   (if (> (length form) 4)
-      (byte-compile-warn "%s used with too many args (%s)"
-			 (car form) (nth 1 form)))
+      (byte-compile-warn
+       "%s %s called with %d arguments, but accepts only %s"
+       (car form) (nth 1 form) (length (cdr form)) 3))
   (if (and (> (length form) 3) (not (stringp (nth 3 form))))
       (byte-compile-warn "Third arg to %s %s is not a string: %s"
 			 (car form) (nth 1 form) (nth 3 form)))
@@ -2106,32 +2170,32 @@ list that represents a doc string reference.
 		  (cons (list name nil nil) byte-compile-call-tree))))
 
     (setq byte-compile-current-form name) ; for warnings
-    (if (memq 'redefine byte-compile-warnings)
-	(byte-compile-arglist-warn form macrop))
-    (if byte-compile-verbose
-	(message "Compiling %s... (%s)"
-		 ;; #### filename used free
-		 (if filename (file-name-nondirectory filename) "")
-		 (nth 1 form)))
+    (when (memq 'redefine byte-compile-warnings)
+      (byte-compile-arglist-warn form macrop))
+    (defvar filename) ; #### filename used free
+    (when byte-compile-verbose
+      (message "Compiling %s... (%s)"
+	       (if filename (file-name-nondirectory filename) "")
+	       (nth 1 form)))
     (cond (that-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; hack hack: don't warn when compiling the stubs in
-		    ;; bytecomp-runtime...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn
-		 "%s defined multiple times, as both function and macro"
-		 (nth 1 form)))
+	   (when (and (memq 'redefine byte-compile-warnings)
+		      ;; hack hack: don't warn when compiling the stubs in
+		      ;; bytecomp-runtime...
+		      (not (assq (nth 1 form)
+				 byte-compile-initial-macro-environment)))
+	     (byte-compile-warn
+	      "%s defined multiple times, as both function and macro"
+	      (nth 1 form)))
 	   (setcdr that-one nil))
 	  (this-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; hack: don't warn when compiling the magic internal
-		    ;; byte-compiler macros in bytecomp-runtime.el...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn "%s %s defined multiple times in this file"
-				  (if macrop "macro" "function")
-				  (nth 1 form))))
+	   (when (and (memq 'redefine byte-compile-warnings)
+		      ;; hack: don't warn when compiling the magic internal
+		      ;; byte-compiler macros in bytecomp-runtime.el...
+		      (not (assq (nth 1 form)
+				 byte-compile-initial-macro-environment)))
+	     (byte-compile-warn "%s %s defined multiple times in this file"
+				(if macrop "macro" "function")
+				(nth 1 form))))
 	  ((and (fboundp name)
 		(or (subrp (symbol-function name))
 		    (eq (car-safe (symbol-function name))
@@ -2145,8 +2209,7 @@ list that represents a doc string reference.
 				  (if macrop "macro" "function")))
 	   ;; shadow existing definition
 	   (set this-kind
-		(cons (cons name nil) (symbol-value this-kind))))
-	  )
+		(cons (cons name nil) (symbol-value this-kind)))))
     (let ((body (nthcdr 3 form)))
       (if (and (stringp (car body))
 	       (symbolp (car-safe (cdr-safe body)))
@@ -2345,11 +2408,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	  (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
 	    (nconc (list 'make-byte-code
 			 (list 'quote (nth 1 fun)) ;arglist
-			 (nth 1 tmp)	;bytes
-			 (nth 2 tmp)	;consts
-			 (nth 3 tmp))	;depth
+			 (nth 1 tmp)	;instructions
+			 (nth 2 tmp)	;constants
+			 (nth 3 tmp))	;stack-depth
 		   (cond ((stringp (nth 2 fun))
-			  (list (nth 2 fun))) ;doc
+			  (list (nth 2 fun))) ;docstring
 			 (interactive
 			  (list nil)))
 		   (cond (interactive
@@ -2371,8 +2434,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (let* ((arglist (nth 1 fun))
 	 (byte-compile-bound-variables
 	  (let ((new-bindings
-		 (mapcar (function (lambda (x)
-				     (cons x byte-compile-arglist-bit)))
+		 (mapcar #'(lambda (x) (cons x byte-compile-arglist-bit))
 			 (and (memq 'free-vars byte-compile-warnings)
 			      (delq '&rest (delq '&optional
 						 (copy-sequence arglist)))))))
@@ -2381,20 +2443,21 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 (body (cdr (cdr fun)))
 	 (doc (if (stringp (car body))
 		  (prog1 (car body)
-		    (setq body (cdr body)))))
+		    ;; Discard the doc string
+		    ;; only if it is not the only element of the body.
+		    (if (cdr body)
+			(setq body (cdr body))))))
 	 (int (assq 'interactive body)))
-    (let ((rest arglist))
-      (while rest
-	(cond ((not (symbolp (car rest)))
-	       (byte-compile-warn "non-symbol in arglist: %s"
-				  (prin1-to-string (car rest))))
-	      ((memq (car rest) '(t nil))
-	       (byte-compile-warn "constant in arglist: %s" (car rest)))
-	      ((and (char= ?\& (aref (symbol-name (car rest)) 0))
-		    (not (memq (car rest) '(&optional &rest))))
-	       (byte-compile-warn "unrecognised `&' keyword in arglist: %s"
-				  (car rest))))
-	(setq rest (cdr rest))))
+    (dolist (arg arglist)
+      (cond ((not (symbolp arg))
+	     (byte-compile-warn "non-symbol in arglist: %S" arg))
+	    ((byte-compile-constant-symbol-p arg)
+	     (byte-compile-warn "constant symbol in arglist: %s" arg))
+	    ((and (char= ?\& (aref (symbol-name arg) 0))
+		  (not (eq arg '&optional))
+		  (not (eq arg '&rest)))
+	     (byte-compile-warn "unrecognized `&' keyword in arglist: %s"
+				arg))))
     (cond (int
 	   ;; Skip (interactive) if it is in front (the most usual location).
 	   (if (eq int (car body))
@@ -2555,8 +2618,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 		     (if (if (eq (car (car rest)) 'byte-constant)
 			     (or (consp tmp)
 				 (and (symbolp tmp)
-				      (not (keywordp tmp))
-				      (not (memq tmp '(nil t))))))
+				      (not (byte-compile-constant-symbol-p tmp)))))
 			 (if maycall
 			     (setq body (cons (list 'quote tmp) body)))
 		       (setq body (cons tmp body))))
@@ -2606,7 +2668,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; This is the recursive entry point for compiling each subform of an
 ;; expression.
 ;; If for-effect is non-nil, byte-compile-form will output a byte-discard
-;; before terminating (ie no value will be left on the stack).
+;; before terminating (ie. no value will be left on the stack).
 ;; A byte-compile handler may, when for-effect is non-nil, choose output code
 ;; which does not leave a value on the stack, and then set for-effect to nil
 ;; (to prevent byte-compile-form from outputting the byte-discard).
@@ -2617,8 +2679,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-form (form &optional for-effect)
   (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))
-	 ;; XEmacs addition: keywordp
-	 (cond ((or (not (symbolp form)) (keywordp form) (memq form '(nil t)))
+	 (cond ((or (not (symbolp form))
+		    (byte-compile-constant-symbol-p form))
 		(byte-compile-constant form))
 	       ((and for-effect byte-compile-delete-errors)
 		(setq for-effect nil))
@@ -2644,8 +2706,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 (byte-compile-form form for-effect)
 	 (setq for-effect nil))
 	((byte-compile-normal-call form)))
-  (if for-effect
-      (byte-compile-discard)))
+  (when for-effect
+    (byte-compile-discard)))
 
 (defun byte-compile-normal-call (form)
   (if byte-compile-generate-call-tree
@@ -2658,12 +2720,14 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (or (fboundp 'globally-boundp) (fset 'globally-boundp 'boundp))
 
 (defun byte-compile-variable-ref (base-op var &optional varbind-flags)
-  (if (or (not (symbolp var)) (keywordp var) (memq var '(nil t)))
-      (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-constant-symbol-p var))
+      (byte-compile-warn
+       (case base-op
+	 (byte-varref "Variable reference to %s %s")
+	 (byte-varset "Attempt to set %s %s")
+	 (byte-varbind "Attempt to let-bind %s %s"))
+       (if (symbolp var) "constant symbol" "non-symbol")
+       var)
     (if (and (get var 'byte-obsolete-variable)
 	     (memq 'obsolete byte-compile-warnings))
 	(let ((ob (get var 'byte-obsolete-variable)))
@@ -2690,6 +2754,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 					 (if (eq base-op 'byte-varset)
 					     byte-compile-assigned-bit
 					   byte-compile-referenced-bit)))))
+	      (and (boundp 'current-load-list)
+		   (memq var current-load-list))
 	      (if (eq base-op 'byte-varset)
 		  (or (memq var byte-compile-free-assignments)
 		      (progn
@@ -2709,11 +2775,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (byte-compile-out base-op tmp)))
 
 (defmacro byte-compile-get-constant (const)
-  (` (or (if (stringp (, const))
-	     (assoc (, const) byte-compile-constants)
-	   (assq (, const) byte-compile-constants))
-	 (car (setq byte-compile-constants
-		    (cons (list (, const)) byte-compile-constants))))))
+  `(or (if (stringp ,const)
+	   (assoc ,const byte-compile-constants)
+	 (assq ,const byte-compile-constants))
+       (car (setq byte-compile-constants
+		  (cons (list ,const) byte-compile-constants)))))
 
 ;; Use this when the value of a form is a constant.  This obeys for-effect.
 (defun byte-compile-constant (const)
@@ -2733,8 +2799,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defmacro byte-defop-compiler (function &optional compile-handler)
   ;; add a compiler-form for 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
+  ;; If FUNCTION is a symbol, then the variable "byte-SYMBOL" must name
+  ;; the opcode to be used.  If is a list, the first element
   ;; is the function and the second element is the bytecode-symbol.
   ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
   ;; may be the abbreviations 0, 1, 2, 3, 0-1, 1-2, 2-3, 0+1, 1+1, 2+1,
@@ -2880,7 +2946,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler char-after		0-1+1)
 (byte-defop-compiler set-buffer		1)
 ;;(byte-defop-compiler set-mark		1) ;; obsolete
-(byte-defop-compiler forward-word	1+1)
+(byte-defop-compiler forward-word	0-1+1)
 (byte-defop-compiler char-syntax	1+1)
 (byte-defop-compiler nreverse		1)
 (byte-defop-compiler car-safe		1)
@@ -2894,12 +2960,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler20 old-memq		2)
 (byte-defop-compiler cons		2)
 (byte-defop-compiler aref		2)
-(byte-defop-compiler (= byte-eqlsign)	byte-compile-one-or-more-args)
-(byte-defop-compiler (< byte-lss)	byte-compile-one-or-more-args)
-(byte-defop-compiler (> byte-gtr)	byte-compile-one-or-more-args)
-(byte-defop-compiler (<= byte-leq)	byte-compile-one-or-more-args)
-(byte-defop-compiler (>= byte-geq)	byte-compile-one-or-more-args)
-(byte-defop-compiler /=			byte-compile-/=)
 (byte-defop-compiler get		2+1)
 (byte-defop-compiler nth		2)
 (byte-defop-compiler substring		2-3)
@@ -2922,9 +2982,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler (rplacd byte-setcdr) 2)
 (byte-defop-compiler setcar		2)
 (byte-defop-compiler setcdr		2)
-;; buffer-substring now has its own function.  This used to be
-;; 2+1, but now all args are optional.
-(byte-defop-compiler buffer-substring)
 (byte-defop-compiler delete-region	2+1)
 (byte-defop-compiler narrow-to-region	2+1)
 (byte-defop-compiler (% byte-rem)	2)
@@ -2933,11 +2990,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler-rmsfun member	2)
 (byte-defop-compiler-rmsfun assq	2)
 
-(byte-defop-compiler max		byte-compile-associative)
-(byte-defop-compiler min		byte-compile-associative)
-(byte-defop-compiler (+ byte-plus)	byte-compile-associative)
-(byte-defop-compiler (* byte-mult)	byte-compile-associative)
-
 ;;####(byte-defop-compiler move-to-column	1)
 (byte-defop-compiler-1 interactive byte-compile-noop)
 (byte-defop-compiler-1 domain byte-compile-domain)
@@ -2954,55 +3006,56 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 
 (defun byte-compile-subr-wrong-args (form n)
-  (byte-compile-warn "%s called with %d arg%s, but requires %s"
-		     (car form) (length (cdr form))
-		     (if (= 1 (length (cdr form))) "" "s") n)
+  (when (memq 'subr-callargs byte-compile-warnings)
+    (byte-compile-warn "%s called with %d arg%s, but requires %s"
+		       (car form) (length (cdr form))
+		       (if (= 1 (length (cdr form))) "" "s") n))
   ;; get run-time wrong-number-of-args error.
   (byte-compile-normal-call form))
 
 (defun byte-compile-no-args (form)
-  (if (not (= (length form) 1))
-      (byte-compile-subr-wrong-args form "none")
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
+  (case (length (cdr form))
+    (0 (byte-compile-out (get (car form) 'byte-opcode) 0))
+    (t (byte-compile-subr-wrong-args form "none"))))
 
 (defun byte-compile-one-arg (form)
-  (if (not (= (length form) 2))
-      (byte-compile-subr-wrong-args form 1)
-    (byte-compile-form (car (cdr form)))  ;; Push the argument
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
+  (case (length (cdr form))
+    (1 (byte-compile-form (car (cdr form)))  ;; Push the argument
+       (byte-compile-out (get (car form) 'byte-opcode) 0))
+    (t (byte-compile-subr-wrong-args form 1))))
 
 (defun byte-compile-two-args (form)
-  (if (not (= (length form) 3))
-      (byte-compile-subr-wrong-args form 2)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
+  (case (length (cdr form))
+    (2 (byte-compile-form (nth 1 form))  ;; Push the arguments
+       (byte-compile-form (nth 2 form))
+       (byte-compile-out (get (car form) 'byte-opcode) 0))
+    (t (byte-compile-subr-wrong-args form 2))))
 
 (defun byte-compile-three-args (form)
-  (if (not (= (length form) 4))
-      (byte-compile-subr-wrong-args form 3)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-form (nth 3 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
+  (case (length (cdr form))
+    (3 (byte-compile-form (nth 1 form))  ;; Push the arguments
+       (byte-compile-form (nth 2 form))
+       (byte-compile-form (nth 3 form))
+       (byte-compile-out (get (car form) 'byte-opcode) 0))
+    (t (byte-compile-subr-wrong-args form 3))))
 
 (defun byte-compile-zero-or-one-arg (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
-	  ((= len 2) (byte-compile-one-arg form))
-	  (t (byte-compile-subr-wrong-args form "0-1")))))
+  (case (length (cdr form))
+    (0 (byte-compile-one-arg (append form '(nil))))
+    (1 (byte-compile-one-arg form))
+    (t (byte-compile-subr-wrong-args form "0-1"))))
 
 (defun byte-compile-one-or-two-args (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
-	  ((= len 3) (byte-compile-two-args form))
-	  (t (byte-compile-subr-wrong-args form "1-2")))))
+  (case (length (cdr form))
+    (1 (byte-compile-two-args (append form '(nil))))
+    (2 (byte-compile-two-args form))
+    (t (byte-compile-subr-wrong-args form "1-2"))))
 
 (defun byte-compile-two-or-three-args (form)
-  (let ((len (length form)))
-    (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
-	  ((= len 4) (byte-compile-three-args form))
-	  (t (byte-compile-subr-wrong-args form "2-3")))))
+  (case (length (cdr form))
+    (2 (byte-compile-three-args (append form '(nil))))
+    (3 (byte-compile-three-args form))
+    (t (byte-compile-subr-wrong-args form "2-3"))))
 
 ;; from Ben Wing <ben@xemacs.org>: some inlined functions have extra
 ;; optional args added to them in XEmacs 19.12.  Changing the byte
@@ -3013,55 +3066,67 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; `byte-compile-subr-wrong-args' also converts the call to non-inlined.
 
 (defun byte-compile-no-args-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-no-args form))
-	  ((= len 2) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "0-1")))))
+  (case (length (cdr form))
+    (0 (byte-compile-no-args form))
+    (1 (if (eq nil (nth 1 form))
+	   (byte-compile-no-args (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "0-1"))))
 
 (defun byte-compile-one-arg-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-one-arg form))
-	  ((= len 3) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "1-2")))))
+  (case (length (cdr form))
+    (1 (byte-compile-one-arg form))
+    (2 (if (eq nil (nth 2 form))
+	   (byte-compile-one-arg (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "1-2"))))
 
 (defun byte-compile-two-args-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 3) (byte-compile-two-args form))
-	  ((= len 4) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "2-3")))))
+  (case (length (cdr form))
+    (2 (byte-compile-two-args form))
+    (3 (if (eq nil (nth 3 form))
+	   (byte-compile-two-args (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "2-3"))))
 
 (defun byte-compile-zero-or-one-arg-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
-	  ((= len 2) (byte-compile-one-arg form))
-	  ((= len 3) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "0-2")))))
+  (case (length (cdr form))
+    (0 (byte-compile-one-arg (append form '(nil))))
+    (1 (byte-compile-one-arg form))
+    (2 (if (eq nil (nth 2 form))
+	   (byte-compile-one-arg (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "0-2"))))
 
 (defun byte-compile-one-or-two-args-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
-	  ((= len 3) (byte-compile-two-args form))
-	  ((= len 4) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "1-3")))))
+  (case (length (cdr form))
+    (1 (byte-compile-two-args (append form '(nil))))
+    (2 (byte-compile-two-args form))
+    (3 (if (eq nil (nth 3 form))
+	   (byte-compile-two-args (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "1-3"))))
 
 (defun byte-compile-two-or-three-args-with-one-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
-	  ((= len 4) (byte-compile-three-args form))
-	  ((= len 5) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "2-4")))))
+  (case (length (cdr form))
+    (2 (byte-compile-three-args (append form '(nil))))
+    (3 (byte-compile-three-args form))
+    (4 (if (eq nil (nth 4 form))
+	   (byte-compile-three-args (butlast form))
+	 (byte-compile-normal-call form)))
+    (t (byte-compile-subr-wrong-args form "2-4"))))
 
 (defun byte-compile-no-args-with-two-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-no-args form))
-	  ((or (= len 2) (= len 3)) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "0-2")))))
+  (case (length (cdr form))
+    (0     (byte-compile-no-args form))
+    ((1 2) (byte-compile-normal-call form))
+    (t     (byte-compile-subr-wrong-args form "0-2"))))
 
 (defun byte-compile-one-arg-with-two-extra (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-one-arg form))
-	  ((or (= len 3) (= len 4)) (byte-compile-normal-call form))
-	  (t (byte-compile-subr-wrong-args form "1-3")))))
+  (case (length (cdr form))
+    (1     (byte-compile-one-arg form))
+    ((2 3) (byte-compile-normal-call form))
+    (t     (byte-compile-subr-wrong-args form "1-3"))))
 
 ;; XEmacs: used for functions that have a different opcode in v19 than v20.
 ;; this includes `eq', `equal', and other old-ified functions.
@@ -3080,21 +3145,31 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-discard ()
   (byte-compile-out 'byte-discard 0))
 
-
-;; Compile a function that accepts one or more args and is right-associative.
-;; We do it by left-associativity so that the operations
-;; are done in the same order as in interpreted code.
-(defun byte-compile-associative (form)
-  (if (cdr form)
-      (let ((opcode (get (car form) 'byte-opcode))
-	    (args (copy-sequence (cdr form))))
-	(byte-compile-form (car args))
-	(setq args (cdr args))
-	(while args
-	  (byte-compile-form (car args))
-	  (byte-compile-out opcode 0)
-	  (setq args (cdr args))))
-    (byte-compile-constant (eval form))))
+(defun byte-compile-max (form)
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-subr-wrong-args form "1 or more"))
+      (1 (byte-compile-form (car args))
+	 (when (not byte-compile-delete-errors)
+	   (byte-compile-out 'byte-dup 0)
+	   (byte-compile-out 'byte-max 0)))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (byte-compile-form elt)
+	   (byte-compile-out 'byte-max 0))))))
+
+(defun byte-compile-min (form)
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-subr-wrong-args form "1 or more"))
+      (1 (byte-compile-form (car args))
+	 (when (not byte-compile-delete-errors)
+	   (byte-compile-out 'byte-dup 0)
+	   (byte-compile-out 'byte-min 0)))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (byte-compile-form elt)
+	   (byte-compile-out 'byte-min 0))))))
 
 
 ;; more complicated compiler macros
@@ -3104,25 +3179,43 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler fset)
 (byte-defop-compiler insert)
 (byte-defop-compiler-1 function byte-compile-function-form)
-(byte-defop-compiler-1 - byte-compile-minus)
-(byte-defop-compiler (/ byte-quo) byte-compile-quo)
+(byte-defop-compiler max)
+(byte-defop-compiler min)
+(byte-defop-compiler (+ byte-plus)	byte-compile-plus)
+(byte-defop-compiler-1 -		byte-compile-minus)
+(byte-defop-compiler (* byte-mult)	byte-compile-mult)
+(byte-defop-compiler (/ byte-quo)	byte-compile-quo)
 (byte-defop-compiler nconc)
 (byte-defop-compiler-1 beginning-of-line)
 
-(defun byte-compile-one-or-more-args (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-subr-wrong-args form "1 or more"))
-	  ((= len 2) (byte-compile-constant t))
-	  ((= len 3) (byte-compile-two-args form))
-	  (t (byte-compile-normal-call form)))))
+(byte-defop-compiler (=  byte-eqlsign)	byte-compile-arithcompare)
+(byte-defop-compiler (<  byte-lss)	byte-compile-arithcompare)
+(byte-defop-compiler (>  byte-gtr)	byte-compile-arithcompare)
+(byte-defop-compiler (<= byte-leq)	byte-compile-arithcompare)
+(byte-defop-compiler (>= byte-geq)	byte-compile-arithcompare)
+
+(defun byte-compile-arithcompare (form)
+  (case (length (cdr form))
+    (0 (byte-compile-subr-wrong-args form "1 or more"))
+    (1 (if byte-compile-delete-errors
+	   (byte-compile-constant t)
+	 (byte-compile-normal-call form)))
+    (2 (byte-compile-two-args form))
+    (t (byte-compile-normal-call form))))
+
+(byte-defop-compiler /= byte-compile-/=)
 
 (defun byte-compile-/= (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-subr-wrong-args form "1 or more"))
-	  ((= len 2) (byte-compile-constant t))
-	  ;; optimize (/= X Y) to (not (= X Y))
-	  ((= len 3) (byte-compile-form-do-effect `(not (= ,@(cdr form)))))
-	  (t (byte-compile-normal-call form)))))
+  (case (length (cdr form))
+    (0 (byte-compile-subr-wrong-args form "1 or more"))
+    (1 (byte-compile-constant t))
+    ;; optimize (/= X Y) to (not (= X Y))
+    (2 (byte-compile-form-do-effect `(not (= ,@(cdr form)))))
+    (t (byte-compile-normal-call form))))
+
+;; buffer-substring now has its own function.  This used to be
+;; 2+1, but now all args are optional.
+(byte-defop-compiler buffer-substring)
 
 (defun byte-compile-buffer-substring (form)
   ;; buffer-substring used to take exactly two args, but now takes 0-3.
@@ -3136,65 +3229,121 @@ If FORM is a lambda or a macro, byte-compile it as a function."
     (t (byte-compile-subr-wrong-args form "0-3"))))
 
 (defun byte-compile-list (form)
-  (let ((count (length (cdr form))))
-    (cond ((= count 0)
-	   (byte-compile-constant nil))
-	  ((< count 5)
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
-	  ((< count 256)
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-listN count))
-	  (t (byte-compile-normal-call form)))))
+  (let* ((args (cdr form))
+	 (nargs (length args)))
+    (cond
+     ((= nargs 0)
+      (byte-compile-constant nil))
+     ((< nargs 5)
+      (mapcar 'byte-compile-form args)
+      (byte-compile-out
+       (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- nargs))
+       0))
+     ((< nargs 256)
+      (mapcar 'byte-compile-form args)
+      (byte-compile-out 'byte-listN nargs))
+     (t (byte-compile-normal-call form)))))
 
 (defun byte-compile-concat (form)
-  (let ((count (length (cdr form))))
-    (cond ((and (< 1 count) (< count 5))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
-	    0))
-	  ;; Concat of one arg is not a no-op if arg is not a string.
-	  ((= count 0)
-	   (byte-compile-form ""))
-	  ((< count 256)
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-concatN count))
-	  ((byte-compile-normal-call form)))))
+  (let* ((args (cdr form))
+	 (nargs (length args)))
+    ;; Concat of one arg is not a no-op if arg is not a string.
+    (cond
+     ((memq nargs '(2 3 4))
+      (mapcar 'byte-compile-form args)
+      (byte-compile-out
+       (aref [byte-concat2 byte-concat3 byte-concat4] (- nargs 2))
+       0))
+     ((eq nargs 0)
+      (byte-compile-form ""))
+     ((< nargs 256)
+      (mapcar 'byte-compile-form args)
+      (byte-compile-out 'byte-concatN nargs))
+     ((byte-compile-normal-call form)))))
+
+(defun byte-compile-plus (form)
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-constant 0))
+      (1 (byte-compile-plus (append form '(0))))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (case elt
+	     (0  (when (not byte-compile-delete-errors)
+		   (byte-compile-constant 0)
+		   (byte-compile-out 'byte-plus 0)))
+	     (+1 (byte-compile-out 'byte-add1 0))
+	     (-1 (byte-compile-out 'byte-sub1 0))
+	     (t
+	      (byte-compile-form elt)
+	      (byte-compile-out 'byte-plus 0))))))))
 
 (defun byte-compile-minus (form)
-  (if (null (setq form (cdr form)))
-      (byte-compile-constant 0)
-    (byte-compile-form (car form))
-    (if (cdr form)
-	(while (setq form (cdr form))
-	  (byte-compile-form (car form))
-	  (byte-compile-out 'byte-diff 0))
-      (byte-compile-out 'byte-negate 0))))
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-subr-wrong-args form "1 or more"))
+      (1 (byte-compile-form (car args))
+	 (byte-compile-out 'byte-negate 0))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (case elt
+	     (0  (when (not byte-compile-delete-errors)
+		   (byte-compile-constant 0)
+		   (byte-compile-out 'byte-diff 0)))
+	     (+1 (byte-compile-out 'byte-sub1 0))
+	     (-1 (byte-compile-out 'byte-add1 0))
+	     (t
+	      (byte-compile-form elt)
+	      (byte-compile-out 'byte-diff 0))))))))
+
+(defun byte-compile-mult (form)
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-constant 1))
+      (1 (byte-compile-mult (append form '(1))))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (case elt
+	     (1  (when (not byte-compile-delete-errors)
+		   (byte-compile-constant 1)
+		   (byte-compile-out 'byte-mult 0)))
+	     (-1 (byte-compile-out 'byte-negate 0))
+	     (2  (byte-compile-out 'byte-dup 0)
+		 (byte-compile-out 'byte-plus 0))
+	     (t
+	      (byte-compile-form elt)
+	      (byte-compile-out 'byte-mult 0))))))))
 
 (defun byte-compile-quo (form)
-  (let ((len (length form)))
-    (cond ((<= len 2)
-	   (byte-compile-subr-wrong-args form "2 or more"))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-quo 0))))))
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-subr-wrong-args form "1 or more"))
+      (1 (byte-compile-constant 1)
+	 (byte-compile-form (car args))
+	 (byte-compile-out 'byte-quo 0))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (case elt
+	     (+1 (when (not byte-compile-delete-errors)
+		   (byte-compile-constant 1)
+		   (byte-compile-out 'byte-quo 0)))
+	     (-1 (byte-compile-out 'byte-negate 0))
+	     (t
+	      (when (and (numberp elt) (= elt 0))
+		(byte-compile-warn "Attempt to divide by zero: %s" form))
+	      (byte-compile-form elt)
+	      (byte-compile-out 'byte-quo 0))))))))
 
 (defun byte-compile-nconc (form)
-  (let ((len (length form)))
-    (cond ((= len 1)
-	   (byte-compile-constant nil))
-	  ((= len 2)
-	   ;; nconc of one arg is a noop, even if that arg isn't a list.
-	   (byte-compile-form (nth 1 form)))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-nconc 0))))))
+  (let ((args (cdr form)))
+    (case (length args)
+      (0 (byte-compile-constant nil))
+      ;; nconc of one arg is a noop, even if that arg isn't a list.
+      (1 (byte-compile-form (car args)))
+      (t (byte-compile-form (car args))
+	 (dolist (elt (cdr args))
+	   (byte-compile-form elt)
+	   (byte-compile-out 'byte-nconc 0))))))
 
 (defun byte-compile-fset (form)
   ;; warn about forms like (fset 'foo '(lambda () ...))
@@ -3203,19 +3352,18 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   ;; I'm sick of getting mail asking me whether that warning is a problem.
   (let ((fn (nth 2 form))
 	body)
-    (if (and (eq (car-safe fn) 'quote)
-	     (eq (car-safe (setq fn (nth 1 fn))) 'lambda)
-	     (not (eq (car-safe (cdr-safe (nth 1 form))) 'make-byte-code)))
-	(progn
-	  (setq body (cdr (cdr fn)))
-	  (if (stringp (car body)) (setq body (cdr body)))
-	  (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
-	  (if (and (consp (car body))
-		   (not (eq 'byte-code (car (car body)))))
-	      (byte-compile-warn
-      "A quoted lambda form is the second argument of fset.  This is probably
+    (when (and (eq (car-safe fn) 'quote)
+	       (eq (car-safe (setq fn (nth 1 fn))) 'lambda)
+	       (not (eq (car-safe (cdr-safe (nth 1 form))) 'make-byte-code)))
+      (setq body (cdr (cdr fn)))
+      (if (stringp (car body)) (setq body (cdr body)))
+      (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
+      (if (and (consp (car body))
+	       (not (eq 'byte-code (car (car body)))))
+	  (byte-compile-warn
+    "A quoted lambda form is the second argument of fset.  This is probably
      not what you want, as that lambda cannot be compiled.  Consider using
-     the syntax (function (lambda (...) ...)) instead.")))))
+     the syntax (function (lambda (...) ...)) instead."))))
   (byte-compile-two-args form))
 
 (defun byte-compile-funarg (form)
@@ -3255,8 +3403,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 (while (setq form (cdr form))
 	   (byte-compile-form (car form))
 	   (byte-compile-out 'byte-insert 0)
-	   (if (cdr form)
-	       (byte-compile-discard))))))
+	   (when (cdr form)
+	     (byte-compile-discard))))))
 
 ;; alas, the old (pre-19.12, and all existing versions of FSFmacs 19)
 ;; byte compiler will generate incorrect code for
@@ -3290,76 +3438,82 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler-1 quote-form)
 
 (defun byte-compile-setq (form)
-  (let ((args (cdr form)))
-    (if args
-	(while args
-	  (byte-compile-form (car (cdr args)))
-	  (or for-effect (cdr (cdr args))
+  (let ((args (cdr form)) var val)
+    (if (null args)
+	;; (setq), with no arguments.
+	(byte-compile-form nil for-effect)
+      (while args
+	(setq var (pop args))
+	(if (null args)
+	    ;; Odd number of args?  Let `set' get the error.
+	    (byte-compile-form `(set ',var) for-effect)
+	  (setq val (pop args))
+	  (if (keywordp var)
+	      ;; (setq :foo ':foo) compatibility kludge
+	      (byte-compile-form `(set ',var ,val) (if args t for-effect))
+	    (byte-compile-form val)
+	    (unless (or args for-effect)
 	      (byte-compile-out 'byte-dup 0))
-	  (byte-compile-variable-ref 'byte-varset (car args))
-	  (setq args (cdr (cdr args))))
-      ;; (setq), with no arguments.
-      (byte-compile-form nil for-effect))
-    (setq for-effect nil)))
+	    (byte-compile-variable-ref 'byte-varset var))))))
+  (setq for-effect nil))
 
 (defun byte-compile-set (form)
   ;; Compile (set 'foo x) as (setq foo x) for trivially better code and so
   ;; that we get applicable warnings.  Compile everything else (including
   ;; malformed calls) like a normal 2-arg byte-coded function.
-  (if (or (not (eq (car-safe (nth 1 form)) 'quote))
-	  (not (= (length form) 3))
-	  (not (= (length (nth 1 form)) 2)))
-      (byte-compile-two-args form)
-    (byte-compile-setq (list 'setq (nth 1 (nth 1 form)) (nth 2 form)))))
+  (let ((symform (nth 1 form))
+	(valform (nth 2 form))
+	sym)
+    (if (and (= (length form) 3)
+	     (= (safe-length symform) 2)
+	     (eq (car symform) 'quote)
+	     (symbolp (setq sym (car (cdr symform))))
+	     (not (byte-compile-constant-symbol-p sym)))
+	(byte-compile-setq `(setq ,sym ,valform))
+      (byte-compile-two-args form))))
 
 (defun byte-compile-setq-default (form)
-  (let ((rest (cdr form)))
-    ;; emit multiple calls to set-default if necessary
-    (while rest
-      (byte-compile-form
-       (list 'set-default (list 'quote (car rest)) (car (cdr rest)))
-       (not (null (cdr (cdr rest)))))
-      (setq rest (cdr (cdr rest))))))
+  (let ((args (cdr form)))
+    (if (null args)
+	;; (setq-default), with no arguments.
+	(byte-compile-form nil for-effect)
+      ;; emit multiple calls to `set-default' if necessary
+      (while args
+	(byte-compile-form
+	 ;; Odd number of args?  Let `set-default' get the error.
+	 `(set-default ',(pop args) ,@(if args (list (pop args)) nil))
+	 (if args t for-effect)))))
+  (setq for-effect nil))
+
 
 (defun byte-compile-set-default (form)
-  (let ((rest (cdr form)))
-    (if (cdr (cdr (cdr form)))
-	;; emit multiple calls to set-default if necessary; all but last
-	;; for-effect (this recurses.)
-	(while rest
-	  (byte-compile-form
-	   (list 'set-default (car rest) (car (cdr rest)))
-	   (not (null (cdr rest))))
-	  (setq rest (cdr (cdr rest))))
-      ;; else, this is the one-armed version
-      (let ((var (nth 1 form))
-	    ;;(val (nth 2 form))
-	    )
-	;; notice calls to set-default/setq-default for variables which
-	;; have not been declared with defvar/defconst.
-	(if (and (memq 'free-vars byte-compile-warnings)
-		 (or (null var)
-		     (and (eq (car-safe var) 'quote)
-			  (= 2 (length var)))))
-	    (let ((sym (nth 1 var))
-		  cell)
-	      (or (and sym (symbolp sym) (globally-boundp sym))
-		  (and (setq cell (assq sym byte-compile-bound-variables))
-		       (setcdr cell (logior (cdr cell)
-					    byte-compile-assigned-bit)))
-		  (memq sym byte-compile-free-assignments)
-		  (if (or (not (symbolp sym)) (memq sym '(t nil)))
-		      (progn
-			(byte-compile-warn
-			 "Attempt to set-globally %s %s"
-			 (if (symbolp sym) "constant" "nonvariable")
-			 (prin1-to-string sym)))
-		    (progn
-		      (byte-compile-warn "assignment to free variable %s" sym)
-		      (setq byte-compile-free-assignments
-			    (cons sym byte-compile-free-assignments)))))))
-	;; now emit a normal call to set-default (or possibly multiple calls)
-	(byte-compile-normal-call form)))))
+  (let* ((args (cdr form))
+	 (nargs (length args))
+	 (var (car args)))
+    (when (and (= (safe-length var) 2)
+	       (eq (car var) 'quote))
+      (let ((sym (nth 1 var)))
+	(cond
+	 ((not (symbolp sym))
+	  (byte-compile-warn "Attempt to set-globally non-symbol %s" sym))
+	 ((byte-compile-constant-symbol-p sym)
+	  (byte-compile-warn "Attempt to set-globally constant symbol %s" sym))
+	 ((let ((cell (assq sym byte-compile-bound-variables)))
+	    (and cell
+		 (setcdr cell (logior (cdr cell) byte-compile-assigned-bit))
+		 t)))
+	 ;; notice calls to set-default/setq-default for variables which
+	 ;; have not been declared with defvar/defconst.
+	 ((globally-boundp sym))	; OK
+	 ((not (memq 'free-vars byte-compile-warnings))) ; warnings suppressed?
+	 ((memq sym byte-compile-free-assignments)) ; already warned about sym
+	 (t
+	  (byte-compile-warn "assignment to free variable %s" sym)
+	  (push sym byte-compile-free-assignments)))))
+    (if (= nargs 2)
+	;; now emit a normal call to set-default
+	(byte-compile-normal-call form)
+      (byte-compile-subr-wrong-args form 2))))
 
 
 (defun byte-compile-quote (form)
@@ -3408,20 +3562,22 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (byte-compile-body-do-effect (cdr form)))
 
 (defun byte-compile-prog1 (form)
-  (byte-compile-form-do-effect (car (cdr form)))
-  (byte-compile-body (cdr (cdr form)) t))
+  (setq form (cdr form))
+  (byte-compile-form-do-effect (pop form))
+  (byte-compile-body form t))
 
 (defun byte-compile-prog2 (form)
-  (byte-compile-form (nth 1 form) t)
-  (byte-compile-form-do-effect (nth 2 form))
-  (byte-compile-body (cdr (cdr (cdr form))) t))
+  (setq form (cdr form))
+  (byte-compile-form (pop form) t)
+  (byte-compile-form-do-effect (pop form))
+  (byte-compile-body form t))
 
 (defmacro byte-compile-goto-if (cond discard tag)
-  (` (byte-compile-goto
-      (if (, cond)
-	  (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
-	(if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
-      (, tag))))
+  `(byte-compile-goto
+    (if ,cond
+	(if ,discard 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
+      (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
+    ,tag))
 
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
@@ -3705,7 +3861,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (byte-defop-compiler-1 defun)
 (byte-defop-compiler-1 defmacro)
 (byte-defop-compiler-1 defvar)
-(byte-defop-compiler-1 defconst byte-compile-defvar)
+(byte-defop-compiler-1 defvar   byte-compile-defvar-or-defconst)
+(byte-defop-compiler-1 defconst byte-compile-defvar-or-defconst)
 (byte-defop-compiler-1 autoload)
 ;; According to Mly this can go now that lambda is a macro
 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
@@ -3733,32 +3890,39 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 		   (list 'quote (cons 'macro (eval code))))))
 	 (list 'quote (nth 1 form)))))
 
-(defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts with doc strings:
-  ;; byte-compile-file-form-defvar will be used in that case.
-  (let ((var (nth 1 form))
+(defun byte-compile-defvar-or-defconst (form)
+  ;; This is not used for file-level defvar/defconsts with doc strings:
+  ;; byte-compile-file-form-defvar-or-defconst will be used in that case.
+  ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
+  (let ((fun (nth 0 form))
+	(var (nth 1 form))
 	(value (nth 2 form))
 	(string (nth 3 form)))
-    (if (> (length form) 4)
-	(byte-compile-warn "%s used with too many args" (car form)))
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons (cons var byte-compile-global-bit)
-		    byte-compile-bound-variables)))
+    (when (> (length form) 4)
+      (byte-compile-warn
+       "%s %s called with %d arguments, but accepts only %s"
+       fun var (length (cdr form)) 3))
+    (when (memq 'free-vars byte-compile-warnings)
+      (push (cons var byte-compile-global-bit) byte-compile-bound-variables))
     (byte-compile-body-do-effect
-     (list (if (cdr (cdr form))
-	       (if (eq (car form) 'defconst)
-		   (list 'setq var value)
-		 (list 'or (list 'boundp (list 'quote var))
-		       (list 'setq var value))))
-	   ;; Put the defined variable in this library's load-history entry
-	   ;; just as a real defvar would.
-	   (list 'setq 'current-load-list
-		 (list 'cons (list 'quote var)
-		       'current-load-list))
-	   (if string
-	       (list 'put (list 'quote var) ''variable-documentation string))
-	   (list 'quote var)))))
+     (list
+      ;; Put the defined variable in this library's load-history entry
+      ;; just as a real defvar would, but only in top-level forms with values.
+      (when (and (> (length form) 2)
+		 (null byte-compile-current-form))
+	`(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))
+	`(put ',var 'variable-documentation ,string))
+      (if (cdr (cdr form))		; `value' provided
+	  (if (eq fun 'defconst)
+	      ;; `defconst' sets `var' unconditionally.
+	      `(setq ,var ,value)
+	    ;; `defvar' sets `var' only when unbound.
+	    `(if (not (default-boundp ',var)) (set-default ',var ,value))))
+      `',var))))
 
 (defun byte-compile-autoload (form)
   (and (byte-compile-constp (nth 1 form))
@@ -3827,7 +3991,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 
 (defun byte-compile-out-tag (tag)
-  (setq byte-compile-output (cons tag byte-compile-output))
+  (push tag byte-compile-output)
   (if (cdr (cdr tag))
       (progn
 	;; ## remove this someday
@@ -3838,7 +4002,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))
@@ -3846,20 +4010,21 @@ 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))
-  (cond ((eq opcode 'byte-call)
-	 (setq byte-compile-depth (- byte-compile-depth offset)))
-	((eq opcode 'byte-return)
-	 ;; This is actually an unnecessary case, because there should be
-	 ;; no more opcodes behind byte-return.
-	 (setq byte-compile-depth nil))
-	(t
-	 (setq byte-compile-depth (+ byte-compile-depth
-				     (or (aref byte-stack+-info
-					       (symbol-value opcode))
-					 (- (1- offset))))
-	       byte-compile-maxdepth (max byte-compile-depth
-					  byte-compile-maxdepth))))
+  (push (cons opcode offset) byte-compile-output)
+  (case opcode
+    (byte-call
+     (setq byte-compile-depth (- byte-compile-depth offset)))
+    (byte-return
+     ;; This is actually an unnecessary case, because there should be
+     ;; no more opcodes behind byte-return.
+     (setq byte-compile-depth nil))
+    (t
+     (setq byte-compile-depth (+ byte-compile-depth
+				 (or (aref byte-stack+-info
+					   (symbol-value opcode))
+				     (- (1- offset))))
+	   byte-compile-maxdepth (max byte-compile-depth
+				      byte-compile-maxdepth))))
   ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
   )
 
@@ -3873,18 +4038,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(or (memq byte-compile-current-form (nth 1 entry)) ;callers
 	    (setcar (cdr entry)
 		    (cons byte-compile-current-form (nth 1 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list (car form) (list byte-compile-current-form) nil)
-		  byte-compile-call-tree)))
+      (push (list (car form) (list byte-compile-current-form) nil)
+	    byte-compile-call-tree))
     ;; annotate the current function
     (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
 	(or (memq (car form) (nth 2 entry)) ;called
 	    (setcar (cdr (cdr entry))
 		    (cons (car form) (nth 2 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list byte-compile-current-form nil (list (car form)))
-		  byte-compile-call-tree)))
-    ))
+      (push (list byte-compile-current-form nil (list (car form)))
+	    byte-compile-call-tree))))
 
 ;; Renamed from byte-compile-report-call-tree
 ;; to avoid interfering with completion of byte-compile-file.
@@ -3923,19 +4085,19 @@ invoked interactively."
 	      (sort byte-compile-call-tree
 		    (cond
 		     ((eq byte-compile-call-tree-sort 'callers)
-		      (function (lambda (x y) (< (length (nth 1 x))
-						 (length (nth 1 y))))))
+		      #'(lambda (x y) (< (length (nth 1 x))
+					 (length (nth 1 y)))))
 		     ((eq byte-compile-call-tree-sort 'calls)
-		      (function (lambda (x y) (< (length (nth 2 x))
-						 (length (nth 2 y))))))
+		      #'(lambda (x y) (< (length (nth 2 x))
+					 (length (nth 2 y)))))
 		     ((eq byte-compile-call-tree-sort 'calls+callers)
-		      (function (lambda (x y) (< (+ (length (nth 1 x))
-						    (length (nth 2 x)))
-						 (+ (length (nth 1 y))
-						    (length (nth 2 y)))))))
+		      #'(lambda (x y) (< (+ (length (nth 1 x))
+					    (length (nth 2 x)))
+					 (+ (length (nth 1 y))
+					    (length (nth 2 y))))))
 		     ((eq byte-compile-call-tree-sort 'name)
-		      (function (lambda (x y) (string< (car x)
-						       (car y)))))
+		      #'(lambda (x y) (string< (car x)
+					       (car y))))
 		     (t (error
 		      "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
 			       byte-compile-call-tree-sort))))))
@@ -4025,36 +4187,50 @@ invoked interactively."
 Use this from the command line, with `-batch';
 it won't work in an interactive Emacs.
 Each file is processed even if an error occurred previously.
-For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
+For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"."
   ;; command-line-args-left is what is left of the command line (from
   ;; startup.el)
   (defvar command-line-args-left)	;Avoid 'free variable' warning
   (if (not noninteractive)
       (error "`batch-byte-compile' is to be used only with -batch"))
-  (let ((error nil)
-	(debug-issue-ebola-notices 0)) ; Hack -slb
+  (let ((error nil))
     (while command-line-args-left
-      (if (file-directory-p (expand-file-name (car command-line-args-left)))
-	  (let ((files (directory-files (car command-line-args-left)))
-		source dest)
-	    (while files
-	      (if (and (string-match emacs-lisp-file-regexp (car files))
-		       (not (auto-save-file-name-p (car files)))
-		       (setq source (expand-file-name
-				     (car files)
-				     (car command-line-args-left)))
-		       (setq dest (byte-compile-dest-file source))
-		       (file-exists-p dest)
-		       (file-newer-than-file-p source dest))
-		  (if (null (batch-byte-compile-1 source))
-		      (setq error t)))
-	      (setq files (cdr files))))
-	(if (null (batch-byte-compile-1 (car command-line-args-left)))
-	    (setq error t)))
-      (setq command-line-args-left (cdr command-line-args-left)))
+      (if (null (batch-byte-compile-one-file))
+	  (setq error t)))
     (message "Done")
     (kill-emacs (if error 1 0))))
 
+;;;###autoload
+(defun batch-byte-compile-one-file ()
+  "Run `byte-compile-file' on a single file remaining on the command line.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs."
+  ;; command-line-args-left is what is left of the command line (from
+  ;; startup.el)
+  (defvar command-line-args-left)	;Avoid 'free variable' warning
+  (if (not noninteractive)
+      (error "`batch-byte-compile-one-file' is to be used only with -batch"))
+  (let (error
+	(file-to-process (car command-line-args-left)))
+    (setq command-line-args-left (cdr command-line-args-left))
+    (if (file-directory-p (expand-file-name file-to-process))
+	(let ((files (directory-files file-to-process))
+	      source dest)
+	  (while files
+	    (if (and (string-match emacs-lisp-file-regexp (car files))
+		     (not (auto-save-file-name-p (car files)))
+		     (setq source (expand-file-name
+				   (car files)
+				   file-to-process))
+		     (setq dest (byte-compile-dest-file source))
+		     (file-exists-p dest)
+		     (file-newer-than-file-p source dest))
+		(if (null (batch-byte-compile-1 source))
+		    (setq error t)))
+	    (setq files (cdr files)))
+	  (null error))
+      (batch-byte-compile-1 file-to-process))))
+
 (defun batch-byte-compile-1 (file)
   (condition-case err
       (progn (byte-compile-file file) t)
@@ -4065,7 +4241,7 @@ For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
      (if (fboundp 'display-error) ; XEmacs 19.8+
 	 (display-error err nil)
        (princ (or (get (car err) 'error-message) (car err)))
-       (mapcar '(lambda (x) (princ " ") (prin1 x)) (cdr err)))
+       (mapcar #'(lambda (x) (princ " ") (prin1 x)) (cdr err)))
      (princ "\n")
      nil)))
 
@@ -4086,8 +4262,7 @@ For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'."
       (error "batch-byte-recompile-directory is to be used only with -batch"))
   (or command-line-args-left
       (setq command-line-args-left '(".")))
-  (let ((byte-recompile-directory-ignore-errors-p t)
-	(debug-issue-ebola-notices 0))
+  (let ((byte-recompile-directory-ignore-errors-p t))
     (while command-line-args-left
       (byte-recompile-directory (car command-line-args-left))
       (setq command-line-args-left (cdr command-line-args-left))))
@@ -4140,10 +4315,10 @@ For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'."
      (assq 'byte-code (symbol-function 'byte-compile-form))
      (let ((byte-optimize nil) ; do it fast
 	   (byte-compile-warnings nil))
-       (mapcar '(lambda (x)
-		  (or noninteractive (message "compiling %s..." x))
-		  (byte-compile x)
-		  (or noninteractive (message "compiling %s...done" x)))
+       (mapcar #'(lambda (x)
+		   (or noninteractive (message "compiling %s..." x))
+		   (byte-compile x)
+		   (or noninteractive (message "compiling %s...done" x)))
 	       '(byte-compile-normal-call
 		 byte-compile-form
 		 byte-compile-body