XEmacs 21.2.33 "Melpomene".

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

diff --git a/lisp/bytecomp.el b/lisp/bytecomp.el
index 95bce46..28ad928 100644 (file)
--- a/lisp/bytecomp.el
+++ b/lisp/bytecomp.el
@@ -3,13 +3,13 @@
 ;;; 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>
+;; Author: Jamie Zawinski <jwz@jwz.org>

 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 ;; Keywords: internal
 
 ;; Subsequently modified by RMS and others.
 
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 ;; Keywords: internal
 
 ;; Subsequently modified by RMS and others.
 

-(defconst byte-compile-version (purecopy  "2.25 XEmacs; 22-Mar-96."))
+(defconst byte-compile-version (purecopy  "2.26 XEmacs; 1998-10-07."))

 
 ;; This file is part of XEmacs.
 
 
 ;; This file is part of XEmacs.
 

@@ -101,6 +101,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)

@@ -171,7 +173,7 @@
 ;;;     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 +212,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 (purecopy "\\.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 +235,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 +259,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 +349,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 +360,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 +373,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.

@@ -620,7 +620,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'")

@@ -770,13 +770,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 +859,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))

@@ -987,7 +970,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

@@ -1225,7 +1208,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))

@@ -1257,7 +1240,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

@@ -1275,12 +1258,14 @@ otherwise pop it")
       (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 +1297,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 +1305,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
+          (condition-case error-info
+              (progn ,@body)
+            (error
+             (byte-compile-report-error error-info)))
+
+        ;; 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,7 +1355,7 @@ 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)
 
 ;;;###autoload
 (defun byte-recompile-directory (directory &optional arg norecursion force)

@@ -1466,8 +1453,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 +1488,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 +1518,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 +1642,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 +1743,29 @@ 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 `raw-text' for maximum portability with non-Mule

   ;; Emacsen.
   ;; Emacsen.

-  (if (featurep 'mule)
-      (if (save-excursion
-           (set-buffer byte-compile-inbuffer)
-           (goto-char (point-min))
-           ;; mrb- There must be a better way than skip-chars-forward
-           (skip-chars-forward (concat (char-to-string 0) "-"
-                                       (char-to-string 255)))
-           (eq (point) (point-max)))
-         (setq buffer-file-coding-system 'no-conversion)
-       (insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
-       (setq buffer-file-coding-system 'escape-quoted)
-       ;; Lazy loading not yet implemented for MULE files
-       ;; 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))))
-       ))
+  (when (featurep '(or mule file-coding))
+    (defvar buffer-file-coding-system)
+    (if (or (featurep '(not mule)) ;; Don't scan buffer if we are not muleized
+           (save-excursion
+             (set-buffer byte-compile-inbuffer)
+             (goto-char (point-min))
+             ;; mrb- There must be a better way than skip-chars-forward
+             (skip-chars-forward (concat (char-to-string 0) "-"
+                                         (char-to-string 255)))
+             (eq (point) (point-max))))
+       (setq buffer-file-coding-system 'raw-text-unix)
+      (insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
+      (setq buffer-file-coding-system 'escape-quoted)
+      ;; #### Lazy loading not yet implemented for MULE files
+      ;; mrb - Fix this someday.
+      (save-excursion
+       (set-buffer byte-compile-inbuffer)
+       (setq byte-compile-dynamic nil
+             byte-compile-dynamic-docstrings nil))
+      ;;(external-debugging-output (prin1-to-string (buffer-local-variables))))
+      ))

   )
 
 
   )
 
 

@@ -1904,8 +1884,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 +1919,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 +1964,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

@@ -2106,32 +2086,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 +2125,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 +2324,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 +2350,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)))))))

@@ -2383,18 +2361,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                  (prog1 (car body)
                    (setq body (cdr body)))))
         (int (assq 'interactive body)))
                  (prog1 (car body)
                    (setq body (cdr body)))))
         (int (assq 'interactive body)))

-    (let ((rest arglist))
-      (while rest
-       (cond ((not (symbolp (car rest)))
-              (byte-compile-warn "non-symbol in arglist: %s"
-                                 (prin1-to-string (car rest))))
-             ((memq (car rest) '(t nil))
-              (byte-compile-warn "constant in arglist: %s" (car rest)))
-             ((and (char= ?\& (aref (symbol-name (car rest)) 0))
-                   (not (memq (car rest) '(&optional &rest))))
-              (byte-compile-warn "unrecognised `&' keyword in arglist: %s"
-                                 (car rest))))
-       (setq rest (cdr rest))))
+    (dolist (arg arglist)
+      (cond ((not (symbolp arg))
+            (byte-compile-warn "non-symbol in arglist: %S" arg))
+           ((byte-compile-constant-symbol-p arg)
+            (byte-compile-warn "constant symbol in arglist: %s" arg))
+           ((and (char= ?\& (aref (symbol-name arg) 0))
+                 (not (eq arg '&optional))
+                 (not (eq arg '&rest)))
+            (byte-compile-warn "unrecognized `&' keyword in arglist: %s"
+                               arg))))

     (cond (int
           ;; Skip (interactive) if it is in front (the most usual location).
           (if (eq int (car body))
     (cond (int
           ;; Skip (interactive) if it is in front (the most usual location).
           (if (eq int (car body))

@@ -2555,8 +2531,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 +2581,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 +2592,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 +2619,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 +2633,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)))

@@ -2709,11 +2686,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)

@@ -2894,12 +2871,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 +2893,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)

@@ -2954,55 +2922,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 +2982,55 @@ 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 (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 (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 (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 (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 (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 (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 +3049,33 @@ 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))))

 
 ;; 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)
 
 ;; 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))))
+  (let ((args (cdr form))
+       (opcode (get (car form) 'byte-opcode)))
+    (case (length args)
+      (0 (byte-compile-constant (eval form)))
+      (t (byte-compile-form (car args))
+        (dolist (arg (cdr args))
+          (byte-compile-form arg)
+          (byte-compile-out opcode 0))))))

 
 \f
 ;; more complicated compiler macros
 
 \f
 ;; more complicated compiler macros

@@ -3109,92 +3090,110 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (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 (byte-compile-constant t))
+    (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)
 
 (defun byte-compile-buffer-substring (form)

-  (let ((len (length form)))
-    ;; buffer-substring used to take exactly two args, but now takes 0-3.
-    ;; convert 0-2 to two args and use special bytecode operand.
-    ;; convert 3 args to a normal call.
-    (cond ((= len 1) (setq form (append form '(nil nil)))
-          (= len 2) (setq form (append form '(nil)))))
-    (cond ((= len 3) (byte-compile-two-args form))
-         ((= len 4) (byte-compile-normal-call form))
-         (t (byte-compile-subr-wrong-args form "0-3")))))
+  ;; buffer-substring used to take exactly two args, but now takes 0-3.
+  ;; convert 0-2 to two args and use special bytecode operand.
+  ;; convert 3 args to a normal call.
+  (case (length (cdr form))
+    (0 (byte-compile-two-args (append form '(nil nil))))
+    (1 (byte-compile-two-args (append form '(nil))))
+    (2 (byte-compile-two-args form))
+    (3 (byte-compile-normal-call form))
+    (t (byte-compile-subr-wrong-args form "0-3"))))

 
 (defun byte-compile-list (form)
 
 (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-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))
+          (byte-compile-form elt)
+          (byte-compile-out 'byte-diff 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))
+          (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 +3202,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 +3253,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 +3288,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 +3412,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)))

@@ -3827,7 +3833,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 +3844,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 +3852,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 +3880,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 +3927,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))))))

@@ -4031,30 +4035,44 @@ For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
   (defvar command-line-args-left)      ;Avoid 'free variable' warning
   (if (not noninteractive)
       (error "`batch-byte-compile' is to be used only with -batch"))
   (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 +4083,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 +4104,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 +4157,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