Sync up with XEmacs 21.4.17.

[chise/xemacs-chise.git.1] / lisp / bytecomp.el

diff --git a/lisp/bytecomp.el b/lisp/bytecomp.el
index 4e0bd04..a7bbe8d 100644 (file)
--- 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.
 
 ;;; 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>
 ;;     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.
 
 
 ;; This file is part of XEmacs.
 

@@ -33,8 +34,15 @@
 ;;; Commentary:
 
 ;; The Emacs Lisp byte compiler.  This crunches lisp source into a
 ;;; 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:
 ;; 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)
 ;;;                            '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)
 ;;;                            '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;
 ;;;                            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
 ;;; 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
 ;;;    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:
 ;;;
 ;;;  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  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).
 ;;;
 ;;;     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 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.
 ;;;
 ;;;     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,
 ;;;     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.")
 
 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.")
 
   "*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)))
 
        (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")
 
 ;; 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.
 ;; 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))
 
 (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
 
 ;; 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
   "*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.
   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.
   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.
 
 (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.
 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)
 
 
 (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
 (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.")
   "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 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'")
 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-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
   "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
 
 (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)
   "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)
             (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))))
            ((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)
            (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)
 (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)
 
 ;; 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))
        (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")
        (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 ()
 
 ;; 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))
 
 (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)
    (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)
 
 ;;; 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
     (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
              val)))
 
 ;; XEmacs addition

@@ -1004,7 +1014,7 @@ otherwise pop it")
              '(emacs19) '(emacs20)))))
 
 ;; now we can copy 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)
 
 (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)
   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))
   ;; 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.
              (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.
 
 
 ;;; 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)
               ;; 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
               ;; 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
     (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)))))
 
 \f
       (setq unreferenced (cdr unreferenced)))))
 
 \f

+(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.
 (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
 
 (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-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)
      (prog1
         (progn ,@body)
        (if (memq 'unused-vars byte-compile-warnings)

@@ -1321,46 +1335,49 @@ otherwise pop it")
           (byte-compile-warn-about-unused-variables)))))
 
 
           (byte-compile-warn-about-unused-variables)))))
 
 

-(defvar byte-compile-warnings-point-max nil)

 (defmacro displaying-byte-compile-warnings (&rest body)
 (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.
      (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)))))))))))

 
 \f
 ;;;###autoload
 
 \f
 ;;;###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): ")
   "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.
 
 ;;;###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,
 
 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.
 
 
 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
 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))))
 
                        (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.
 ;;;###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)
       (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))
        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.
        (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)
        (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
 
        ;; 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)))
                               (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.
   ;; 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.
   ;; 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)))
            (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))
        ;; 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)
             (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)
 
     (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,
       (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)
 ;; 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)))
               (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
        (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)))
 
     ;; 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)
   (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)))
   (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
                  (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
     (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
           (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))
          ((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
                                  (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)))
     (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
          (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))
                   (cond ((stringp (nth 2 fun))

-                         (list (nth 2 fun))) ;doc
+                         (list (nth 2 fun))) ;docstring

                         (interactive
                          (list nil)))
                   (cond (interactive
                         (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
   (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)))))))
                         (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)
         (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)))
         (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))
     (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)
                     (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))))
                         (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
 ;; 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).
 ;; 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))
 (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))
                (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)))
         (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
 
 (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)
 (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)))
     (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)))))
                                         (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
              (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)
     (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)
 
 ;; 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.
 
 (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,
   ;; 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 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)
 (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-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)
 (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)
 (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)
 (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-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)
 ;;####(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."
 
 \f
 (defun byte-compile-subr-wrong-args (form n)
 
 \f
 (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)
   ;; 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)
 
 (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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
 
 ;; 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)
 ;; `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)
 
 (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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.
 
 ;; 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))
 
 (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))))))

 
 \f
 ;; more complicated compiler macros
 
 \f
 ;; 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 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)
 
 (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)
 
 (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.
 
 (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)
     (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)
 
 (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)
 
 (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)
 
 (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)
 
 (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 () ...))
 
 (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)
   ;; 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
      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)
   (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)
         (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
 
 ;; 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)
 (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-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.
 
 (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)
 
 (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)
 
 (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)
 
 
 (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-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)
 
 (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)
 
 (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)))
 
 (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 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)
 (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)))))
 
                   (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)))
        (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
     (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))
 
 (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)
 
 
 (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
   (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)
     (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))
   (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)
                                (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"))
   )
 
   ;;(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))))
        (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))))
     ;; 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.
 
 ;; 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)
              (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)
                     ((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)
                     ((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)
                     ((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))))))
                     (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.
 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"))
   ;; 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
     (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))))
 
     (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)
 (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)))
      (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)))
 
      (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 '(".")))
       (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))))
     (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))
      (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
               '(byte-compile-normal-call
                 byte-compile-form
                 byte-compile-body