*** empty log message ***

4 files changed, 99 insertions, 60 deletions

diff --git a/lisp/cl.el b/lisp/cl.el
index c86b24ffe2b..b675d926fb8 100644
--- a/lisp/cl.el
+++ b/lisp/cl.el
@@ -691,25 +691,34 @@ list accessors: first, second, ..., tenth, rest."
          (arg       (cadr form))
          (valid     *cl-valid-named-list-accessors*)
          (offsets   *cl-valid-nth-offsets*))
-    (if (or (null (cdr form)) (cddr form))
-        (error "%s needs exactly one argument, seen `%s'"
-               fun (prin1-to-string form)))
-    (if (not (memq fun valid))
-        (error "`%s' not in {first, ..., tenth, rest}" fun))
-    (cond ((eq fun 'first)
-           (byte-compile-form arg)
-           (setq byte-compile-depth (1- byte-compile-depth))
-           (byte-compile-out byte-car 0))
-          ((eq fun 'rest)
-           (byte-compile-form arg)
-           (setq byte-compile-depth (1- byte-compile-depth))
-           (byte-compile-out byte-cdr 0))
-          (t                            ;one of the others
-           (byte-compile-constant (cdr (assoc fun offsets)))
-           (byte-compile-form arg)
-           (setq byte-compile-depth (1- byte-compile-depth))
-           (byte-compile-out byte-nth 0)
-           ))))
+    (cond
+
+     ;; Check that it's a form we're prepared to handle.
+     ((not (memq fun valid))
+      (error
+       "cl.el internal bug: `%s' not in {first, ..., tenth, rest}"
+       fun))
+
+     ;; Check the number of arguments.
+     ((not (= (length form) 2))
+      (byte-compile-subr-wrong-args form 1))
+
+     ;; If the result will simply be tossed, don't generate any code for
+     ;; it, and indicate that we have already discarded the value.
+     (for-effect
+      (setq for-effect nil))
+
+     ;; Generate code for the call.
+     ((eq fun 'first)
+      (byte-compile-form arg)
+      (byte-compile-out 'byte-car 0))
+     ((eq fun 'rest)
+      (byte-compile-form arg)
+      (byte-compile-out 'byte-cdr 0))
+     (t                         ;one of the others
+      (byte-compile-constant (cdr (assq fun offsets)))
+      (byte-compile-form arg)
+      (byte-compile-out 'byte-nth 0)))))
 
 ;;; Synonyms for list functions
 (defun first (x)
@@ -851,18 +860,31 @@ To use this functionality for a given function,just give its name a
                                       'byte-car 'byte-cdr)))
                       (cdr (nreverse (cdr (append (symbol-name fun) nil)))))))
     ;; SEQ is a list of byte-car and byte-cdr in the correct order.
-    (if (null seq)
-        (error "internal: `%s' cannot be compiled by byte-compile-ca*d*r"
-               (prin1-to-string form)))
-    (if (or (null (cdr form)) (cddr form))
-        (error "%s needs exactly one argument, seen `%s'"
-               fun (prin1-to-string form)))
-    (byte-compile-form arg)
-    (setq byte-compile-depth (1- byte-compile-depth))
-    ;; the rest of this code doesn't change the stack depth!
-    (while seq
-      (byte-compile-out (car seq) 0)
-      (setq seq (cdr seq)))))
+    (cond
+
+     ;; Is this a function we can handle?
+     ((null seq)
+      (error
+       "cl.el internal bug: `%s' cannot be compiled by byte-compile-ca*d*r"
+       (prin1-to-string form)))
+
+     ;; Are we passing this function the correct number of arguments?
+     ((or (null (cdr form)) (cddr form))
+      (byte-compile-subr-wrong-args form 1))
+
+     ;; Are we evaluating this expression for effect only?
+     (for-effect
+
+      ;; We needn't generate any actual code, as long as we tell the rest 
+      ;; of the compiler that we didn't push anything on the stack.
+      (setq for-effect nil))
+
+     ;; Generate code for the function.
+     (t
+      (byte-compile-form arg)
+      (while seq
+        (byte-compile-out (car seq) 0)
+        (setq seq (cdr seq)))))))
 
 (defun caar (X)
   "Return the car of the car of X."
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 344abcb5d11..f9bbf4d6464 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -242,7 +242,8 @@ If it is 'byte, then only byte-level optimizations will be logged.")
 of `message.'")
 
 (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved))
-(defvar byte-compile-warnings (not noninteractive)
+(defvar byte-compile-warnings (if noninteractive nil
+                                (delq 'free-vars byte-compile-warning-types))
   "*List of warnings that the byte-compiler should issue (t for all).
 Valid elements of this list are:
 `free-vars' (references to variables not in the
@@ -734,6 +735,14 @@ otherwise pop it")
 ;;;     (message "Warning: %s" format))
     ))
 
+;;; This function should be used to report errors that have halted
+;;; compilation of the current file.
+(defun byte-compile-report-error (error-info)
+  (setq format (format (if (cdr error-info) "%s (%s)" "%s")
+                       (get (car error-info) 'error-message)
+                       (prin1-to-string (cdr error-info))))
+  (byte-compile-log-1 (concat "!! " format)))
+
 ;;; Used by make-obsolete.
 (defun byte-compile-obsolete (form)
   (let ((new (get (car form) 'byte-obsolete-info)))
@@ -1004,7 +1013,11 @@ otherwise pop it")
              (save-excursion
                (set-buffer (get-buffer-create "*Compile-Log*"))
                (point-max)))))
-     (list 'unwind-protect (cons 'progn body)
+     (list 'unwind-protect
+           (list 'condition-case 'error-info
+                 (cons 'progn body)
+               '(error
+                 (byte-compile-report-error error-info)))
        '(save-excursion
           ;; If there were compilation warnings, display them.
           (set-buffer "*Compile-Log*")
@@ -1090,28 +1103,31 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling."
         (set-auto-mode)
         (setq filename buffer-file-name))
       (kill-buffer (prog1 (current-buffer)
-                     (set-buffer (byte-compile-from-buffer (current-buffer)))))
+                     (set-buffer
+                      (byte-compile-from-buffer (current-buffer)))))
       (goto-char (point-max))
-      (insert "\n") ; aaah, unix.
+      (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)))
+;;      (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
+            (let ((kanji-flag nil))     ; for nemacs, from Nakagawa Takayuki
               (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)))
+          ;; 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
@@ -1180,17 +1196,17 @@ With argument, insert value in current buffer after the form."
           (byte-compile-depth 0)
           (byte-compile-maxdepth 0)
           (byte-compile-output nil)
-          ;; #### This is bound in b-c-close-variables.
-          ;;(byte-compile-warnings (if (eq byte-compile-warnings t)
-          ;;                          byte-compile-warning-types
-          ;;                        byte-compile-warnings))
+;;        #### This is bound in b-c-close-variables.
+;;        (byte-compile-warnings (if (eq byte-compile-warnings t)
+;;                                   byte-compile-warning-types
+;;                                 byte-compile-warnings))
           )
       (byte-compile-close-variables
        (save-excursion
          (setq outbuffer
                (set-buffer (get-buffer-create " *Compiler Output*")))
          (erase-buffer)
-;;       (emacs-lisp-mode)
+         ;;      (emacs-lisp-mode)
          (setq case-fold-search nil))
        (displaying-byte-compile-warnings
         (save-excursion
@@ -1206,8 +1222,9 @@ With argument, insert value in current buffer after the form."
           (byte-compile-flush-pending)
           (and (not eval) (byte-compile-insert-header))
           (byte-compile-warn-about-unresolved-functions)
-          ;; always do this?  When calling multiple files, it would be useful
-          ;; to delay this warning until all have been compiled.
+          ;; always do this?  When calling multiple files, it
+          ;; would be useful to delay this warning until all have
+          ;; been compiled.
           (setq byte-compile-unresolved-functions nil)))
        (save-excursion
          (set-buffer outbuffer)
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 5dad2f86c0c..52f5abc5220 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -76,7 +76,7 @@ See definition of `print-region-1' for calling conventions.")
       (if page-headers
           (if (eq system-type 'usg-unix-v)
               (progn
-                (print-region-new-buffer)
+                (print-region-new-buffer start end)
                 (call-process-region start end "pr" t t nil))
             ;; On BSD, use an option to get page headers.
             (setq switches (cons "-p" switches))))
@@ -92,7 +92,7 @@ See definition of `print-region-1' for calling conventions.")
 ;; into a new buffer, makes that buffer current,
 ;; and sets start and end to the buffer bounds.
 ;; start and end are used free.
-(defun print-region-new-buffer ()
+(defun print-region-new-buffer (start end)
   (or (string= (buffer-name) " *spool temp*")
       (let ((oldbuf (current-buffer)))
         (set-buffer (get-buffer-create " *spool temp*"))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index b29ebe6bf56..16178c018e2 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -582,7 +582,7 @@ NOT including one on this line."
          (hif-endif-to-ifdef))
         ((hif-looking-at-ifX)
          'done)
-        (t ; never gets here)))
+        (t)))                   ; never gets here
 
 
 (defun forward-ifdef (&optional arg)