Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk

1 files changed, 542 insertions, 508 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index f29f85b9650..66a117fccc8 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -284,8 +284,10 @@
                           ;; If `fn' is from the same file, it has already
                           ;; been preprocessed!
                           `(function ,fn)
-                        (byte-compile-preprocess
-                         (byte-compile--reify-function fn)))))
+                        ;; Try and process it "in its original environment".
+                        (let ((byte-compile-bound-variables nil))
+                          (byte-compile-preprocess
+                           (byte-compile--reify-function fn))))))
            (if (eq (car-safe newfn) 'function)
                (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
              ;; This can happen because of macroexp-warn-and-return &co.
@@ -1561,467 +1563,548 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	;; You may notice that sequences like "dup varset discard" are
 	;; optimized but sequences like "dup varset TAG1: discard" are not.
 	;; You may be tempted to change this; resist that temptation.
-	(cond ;;
-	      ;; <side-effect-free> pop -->  <deleted>
-	      ;;  ...including:
-	      ;; const-X pop   -->  <deleted>
-	      ;; varref-X pop  -->  <deleted>
-	      ;; dup pop       -->  <deleted>
-	      ;;
-	      ((and (eq 'byte-discard (car lap1))
-		    (memq (car lap0) side-effect-free))
-	       (setq keep-going t)
-	       (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
-	       (setq rest (cdr rest))
-	       (cond ((= tmp 1)
-		      (byte-compile-log-lap
- 		       "  %s discard\t-->\t<deleted>" lap0)
-		      (setq lap (delq lap0 (delq lap1 lap))))
-		     ((= tmp 0)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\t<deleted> discard" lap0)
-		      (setq lap (delq lap0 lap)))
-		     ((= tmp -1)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\tdiscard discard" lap0)
-		      (setcar lap0 'byte-discard)
-		      (setcdr lap0 0))
-		     ((error "Optimizer error: too much on the stack"))))
-	      ;;
-	      ;; goto*-X X:  -->  X:
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (eq (cdr lap0) lap1))
-	       (cond ((eq (car lap0) 'byte-goto)
-		      (setq lap (delq lap0 lap))
-		      (setq tmp "<deleted>"))
-		     ((memq (car lap0) byte-goto-always-pop-ops)
-		      (setcar lap0 (setq tmp 'byte-discard))
-		      (setcdr lap0 0))
-		     ((error "Depth conflict at tag %d" (nth 2 lap0))))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
-				      (nth 1 lap1) (nth 1 lap1)
-				      tmp (nth 1 lap1)))
-	       (setq keep-going t))
-	      ;;
-	      ;; varset-X varref-X  -->  dup varset-X
-	      ;; varbind-X varref-X  -->  dup varbind-X
-	      ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
-	      ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
-	      ;; The latter two can enable other optimizations.
-	      ;;
-              ;; For lexical variables, we could do the same
-              ;;   stack-set-X+1 stack-ref-X  -->  dup stack-set-X+2
-              ;; but this is a very minor gain, since dup is stack-ref-0,
-              ;; i.e. it's only better if X>5, and even then it comes
-              ;; at the cost of an extra stack slot.  Let's not bother.
-	      ((and (eq 'byte-varref (car lap2))
-                    (eq (cdr lap1) (cdr lap2))
-                    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
-			(not (eq (car lap0) 'byte-constant)))
-		   nil
-		 (setq keep-going t)
-                 (if (memq (car lap0) '(byte-constant byte-dup))
-                     (progn
-                       (setq tmp (if (or (not tmp)
-                                         (macroexp--const-symbol-p
-                                          (car (cdr lap0))))
-                                     (cdr lap0)
-                                   (byte-compile-get-constant t)))
-		       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
-					     lap0 lap1 lap2 lap0 lap1
-					     (cons (car lap0) tmp))
-		       (setcar lap2 (car lap0))
-		       (setcdr lap2 tmp))
-		   (byte-compile-log-lap "  %s %s\t-->\tdup %s" lap1 lap2 lap1)
-		   (setcar lap2 (car lap1))
-		   (setcar lap1 'byte-dup)
-		   (setcdr lap1 0)
-		   ;; The stack depth gets locally increased, so we will
-		   ;; increase maxdepth in case depth = maxdepth here.
-		   ;; This can cause the third argument to byte-code to
-		   ;; be larger than necessary.
-		   (setq add-depth 1))))
-	      ;;
-	      ;; dup varset-X discard  -->  varset-X
-	      ;; dup varbind-X discard  -->  varbind-X
-              ;; dup stack-set-X discard  -->  stack-set-X-1
-	      ;; (the varbind variant can emerge from other optimizations)
-	      ;;
-	      ((and (eq 'byte-dup (car lap0))
-		    (eq 'byte-discard (car lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind
-                                       byte-stack-set)))
-	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
-	       (setq keep-going t
-		     rest (cdr rest))
-               (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
-	       (setq lap (delq lap0 (delq lap2 lap))))
-	      ;;
-	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
-	      ;; not goto-X-if-non-nil          -->  goto-X-if-nil
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;;
-	      ((and (eq 'byte-not (car lap0))
-		    (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil)))
-	       (byte-compile-log-lap "  not %s\t-->\t%s"
-				     lap1
-				     (cons
-				      (if (eq (car lap1) 'byte-goto-if-nil)
-					  'byte-goto-if-not-nil
-					'byte-goto-if-nil)
-				      (cdr lap1)))
-	       (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
-				'byte-goto-if-not-nil
-				'byte-goto-if-nil))
-	       (setq lap (delq lap0 lap))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
-	      ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;;
-	      ((and (memq (car lap0)
-                          '(byte-goto-if-nil byte-goto-if-not-nil))	; gotoX
-		    (eq 'byte-goto (car lap1))			; gotoY
-		    (eq (cdr lap0) lap2))			; TAG X
-	       (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
-				  'byte-goto-if-not-nil 'byte-goto-if-nil)))
-		 (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
-				       lap0 lap1 lap2
-				       (cons inverse (cdr lap1)) lap2)
-		 (setq lap (delq lap0 lap))
-		 (setcar lap1 inverse)
-		 (setq keep-going t)))
-	      ;;
-	      ;; const goto-if-* --> whatever
-	      ;;
-	      ((and (eq 'byte-constant (car lap0))
-		    (memq (car lap1) byte-conditional-ops)
-                    ;; If the `byte-constant's cdr is not a cons cell, it has
-                    ;; to be an index into the constant pool); even though
-                    ;; it'll be a constant, that constant is not known yet
-                    ;; (it's typically a free variable of a closure, so will
-                    ;; only be known when the closure will be built at
-                    ;; run-time).
-                    (consp (cdr lap0)))
-	       (cond ((if (memq (car lap1) '(byte-goto-if-nil
-                                             byte-goto-if-nil-else-pop))
-                          (car (cdr lap0))
-                        (not (car (cdr lap0))))
-		      (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
-					    lap0 lap1)
-		      (setq rest (cdr rest)
-			    lap (delq lap0 (delq lap1 lap))))
-		     (t
-		      (byte-compile-log-lap "  %s %s\t-->\t%s"
-					    lap0 lap1
-					    (cons 'byte-goto (cdr lap1)))
-		      (when (memq (car lap1) byte-goto-always-pop-ops)
-			(setq lap (delq lap0 lap)))
-		      (setcar lap1 'byte-goto)))
-               (setq keep-going t))
-	      ;;
-	      ;; varref-X varref-X  -->  varref-X dup
-	      ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
-	      ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
-	      ;; We don't optimize the const-X variations on this here,
-	      ;; because that would inhibit some goto optimizations; we
-	      ;; optimize the const-X case after all other optimizations.
-	      ;;
-	      ((and (memq (car lap0) '(byte-varref byte-stack-ref))
-		    (progn
-		      (setq tmp (cdr rest))
-                      (setq tmp2 0)
-		      (while (eq (car (car tmp)) 'byte-dup)
-			(setq tmp2 (1+ tmp2))
-                        (setq tmp (cdr tmp)))
-		      t)
-		    (eq (if (eq 'byte-stack-ref (car lap0))
-                            (+ tmp2 1 (cdr lap0))
-                          (cdr lap0))
-                        (cdr (car tmp)))
-		    (eq (car lap0) (car (car tmp))))
-	       (if (memq byte-optimize-log '(t byte))
-		   (let ((str ""))
-		     (setq tmp2 (cdr rest))
-		     (while (not (eq tmp tmp2))
-		       (setq tmp2 (cdr tmp2)
-			     str (concat str " dup")))
-		     (byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
-					   lap0 str lap0 lap0 str)))
-	       (setq keep-going t)
-	       (setcar (car tmp) 'byte-dup)
-	       (setcdr (car tmp) 0)
-	       (setq rest tmp))
-	      ;;
-	      ;; TAG1: TAG2: --> TAG1: <deleted>
-	      ;; (and other references to TAG2 are replaced with TAG1)
-	      ;;
-	      ((and (eq (car lap0) 'TAG)
-		    (eq (car lap1) 'TAG))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  adjacent tags %d and %d merged"
-				      (nth 1 lap1) (nth 1 lap0)))
-	       (setq tmp3 lap)
-	       (while (setq tmp2 (rassq lap0 tmp3))
-		 (setcdr tmp2 lap1)
-		 (setq tmp3 (cdr (memq tmp2 tmp3))))
-	       (setq lap (delq lap0 lap)
-		     keep-going t)
-               ;; replace references to tag in jump tables, if any
-               (dolist (table byte-compile-jump-tables)
-                   (maphash #'(lambda (value tag)
-                                (when (equal tag lap0)
-                                  (puthash value lap1 table)))
-                            table)))
-	      ;;
-	      ;; unused-TAG: --> <deleted>
-	      ;;
-	      ((and (eq 'TAG (car lap0))
-		    (not (rassq lap0 lap))
-                    ;; make sure this tag isn't used in a jump-table
-                    (cl-loop for table in byte-compile-jump-tables
-                             when (member lap0 (hash-table-values table))
-                             return nil finally return t))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
-	       (setq lap (delq lap0 lap)
-		     keep-going t))
-	      ;;
-	      ;; goto   ... --> goto   <delete until TAG or end>
-	      ;; return ... --> return <delete until TAG or end>
-	      ;; (unless a jump-table is being used, where deleting may affect
-              ;; other valid case bodies)
-              ;;
-	      ((and (memq (car lap0) '(byte-goto byte-return))
-		    (not (memq (car lap1) '(TAG nil)))
-                    ;; FIXME: Instead of deferring simply when jump-tables are
-                    ;; being used, keep a list of tags used for switch tags and
-                    ;; use them instead (see `byte-compile-inline-lapcode').
-                    (not byte-compile-jump-tables))
-	       (setq tmp rest)
-	       (let ((i 0)
-		     (opt-p (memq byte-optimize-log '(t lap)))
-		     str deleted)
-		 (while (and (setq tmp (cdr tmp))
-			     (not (eq 'TAG (car (car tmp)))))
-		   (if opt-p (setq deleted (cons (car tmp) deleted)
-				   str (concat str " %s")
-				   i (1+ i))))
-		 (if opt-p
-		     (let ((tagstr
-			    (if (eq 'TAG (car (car tmp)))
-				(format "%d:" (car (cdr (car tmp))))
-			      (or (car tmp) ""))))
-		       (if (< i 6)
-			   (apply 'byte-compile-log-lap-1
-				  (concat "  %s" str
-					  " %s\t-->\t%s <deleted> %s")
-				  lap0
-				  (nconc (nreverse deleted)
-					 (list tagstr lap0 tagstr)))
-			 (byte-compile-log-lap
-			  "  %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
-			  lap0 i (if (= i 1) "" "s")
-			  tagstr lap0 tagstr))))
-		 (rplacd rest tmp))
-	       (setq keep-going t))
-	      ;;
-	      ;; <safe-op> unbind --> unbind <safe-op>
-	      ;; (this may enable other optimizations.)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) byte-after-unbind-ops))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
-	       (setcar rest lap1)
-	       (setcar (cdr rest) lap0)
-	       (setq keep-going t))
-	      ;;
-	      ;; varbind-X unbind-N         -->  discard unbind-(N-1)
-	      ;; save-excursion unbind-N    -->  unbind-(N-1)
-	      ;; save-restriction unbind-N  -->  unbind-(N-1)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) '(byte-varbind byte-save-excursion
-				       byte-save-restriction))
-		    (< 0 (cdr lap1)))
-	       (if (zerop (setcdr lap1 (1- (cdr lap1))))
-		   (delq lap1 rest))
-	       (if (eq (car lap0) 'byte-varbind)
-		   (setcar rest (cons 'byte-discard 0))
+	(cond
+	 ;; <side-effect-free> pop -->  <deleted>
+	 ;;  ...including:
+	 ;; const-X pop   -->  <deleted>
+	 ;; varref-X pop  -->  <deleted>
+	 ;; dup pop       -->  <deleted>
+	 ;;
+	 ((and (eq 'byte-discard (car lap1))
+	       (memq (car lap0) side-effect-free))
+	  (setq keep-going t)
+	  (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
+	  (setq rest (cdr rest))
+	  (cond ((= tmp 1)
+		 (byte-compile-log-lap
+		  "  %s discard\t-->\t<deleted>" lap0)
+		 (setq lap (delq lap0 (delq lap1 lap))))
+		((= tmp 0)
+		 (byte-compile-log-lap
+		  "  %s discard\t-->\t<deleted> discard" lap0)
 		 (setq lap (delq lap0 lap)))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s"
-		 lap0 (cons (car lap1) (1+ (cdr lap1)))
-		 (if (eq (car lap0) 'byte-varbind)
-		     (car rest)
-		   (car (cdr rest)))
-		 (if (and (/= 0 (cdr lap1))
-			  (eq (car lap0) 'byte-varbind))
-		     (car (cdr rest))
-		   ""))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto*-X ... X: goto-Y  --> goto*-Y
-	      ;; goto-X ...  X: return  --> return
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
-			  '(byte-goto byte-return)))
-	       (cond ((and (not (eq tmp lap0))
-			   (or (eq (car lap0) 'byte-goto)
-			       (eq (car tmp) 'byte-goto)))
-		      (byte-compile-log-lap "  %s [%s]\t-->\t%s"
-					    (car lap0) tmp tmp)
-		      (if (eq (car tmp) 'byte-return)
-			  (setcar lap0 'byte-return))
-		      (setcdr lap0 (cdr tmp))
-		      (setq keep-going t))))
-	      ;;
-	      ;; goto-*-else-pop X ... X: goto-if-* --> whatever
-	      ;; goto-*-else-pop X ... X: discard --> whatever
-	      ;;
-	      ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
-				       byte-goto-if-not-nil-else-pop))
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
-			  (eval-when-compile
-			   (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap0 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
-					      byte-goto-if-nil)
-					     (byte-goto-if-not-nil-else-pop
-					      byte-goto-if-not-nil))))
-	       (if (memq (car tmp2) tmp3)
-		   (progn (setcar lap0 (car tmp2))
-			  (setcdr lap0 (cdr tmp2))
-			  (byte-compile-log-lap "  %s-else-pop [%s]\t-->\t%s"
-						(car lap0) tmp2 lap0))
-		 ;; Get rid of the -else-pop's and jump one step further.
+		((= tmp -1)
+		 (byte-compile-log-lap
+		  "  %s discard\t-->\tdiscard discard" lap0)
+		 (setcar lap0 'byte-discard)
+		 (setcdr lap0 0))
+		((error "Optimizer error: too much on the stack"))))
+	 ;;
+	 ;; goto*-X X:  -->  X:
+	 ;;
+	 ((and (memq (car lap0) byte-goto-ops)
+	       (eq (cdr lap0) lap1))
+	  (cond ((eq (car lap0) 'byte-goto)
+		 (setq lap (delq lap0 lap))
+		 (setq tmp "<deleted>"))
+		((memq (car lap0) byte-goto-always-pop-ops)
+		 (setcar lap0 (setq tmp 'byte-discard))
+		 (setcdr lap0 0))
+		((error "Depth conflict at tag %d" (nth 2 lap0))))
+	  (and (memq byte-optimize-log '(t byte))
+	       (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
+				 (nth 1 lap1) (nth 1 lap1)
+				 tmp (nth 1 lap1)))
+	  (setq keep-going t))
+	 ;;
+	 ;; varset-X varref-X  -->  dup varset-X
+	 ;; varbind-X varref-X  -->  dup varbind-X
+	 ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
+	 ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
+	 ;; The latter two can enable other optimizations.
+	 ;;
+         ;; For lexical variables, we could do the same
+         ;;   stack-set-X+1 stack-ref-X  -->  dup stack-set-X+2
+         ;; but this is a very minor gain, since dup is stack-ref-0,
+         ;; i.e. it's only better if X>5, and even then it comes
+         ;; at the cost of an extra stack slot.  Let's not bother.
+	 ((and (eq 'byte-varref (car lap2))
+               (eq (cdr lap1) (cdr lap2))
+               (memq (car lap1) '(byte-varset byte-varbind)))
+	  (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
+		   (not (eq (car lap0) 'byte-constant)))
+	      nil
+	    (setq keep-going t)
+            (if (memq (car lap0) '(byte-constant byte-dup))
+                (progn
+                  (setq tmp (if (or (not tmp)
+                                    (macroexp--const-symbol-p
+                                     (car (cdr lap0))))
+                                (cdr lap0)
+                              (byte-compile-get-constant t)))
+		  (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
+					lap0 lap1 lap2 lap0 lap1
+					(cons (car lap0) tmp))
+		  (setcar lap2 (car lap0))
+		  (setcdr lap2 tmp))
+	      (byte-compile-log-lap "  %s %s\t-->\tdup %s" lap1 lap2 lap1)
+	      (setcar lap2 (car lap1))
+	      (setcar lap1 'byte-dup)
+	      (setcdr lap1 0)
+	      ;; The stack depth gets locally increased, so we will
+	      ;; increase maxdepth in case depth = maxdepth here.
+	      ;; This can cause the third argument to byte-code to
+	      ;; be larger than necessary.
+	      (setq add-depth 1))))
+	 ;;
+	 ;; dup varset-X discard  -->  varset-X
+	 ;; dup varbind-X discard  -->  varbind-X
+         ;; dup stack-set-X discard  -->  stack-set-X-1
+	 ;; (the varbind variant can emerge from other optimizations)
+	 ;;
+	 ((and (eq 'byte-dup (car lap0))
+	       (eq 'byte-discard (car lap2))
+	       (memq (car lap1) '(byte-varset byte-varbind
+                                  byte-stack-set)))
+	  (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
+	  (setq keep-going t
+		rest (cdr rest))
+          (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
+	  (setq lap (delq lap0 (delq lap2 lap))))
+	 ;;
+	 ;; not goto-X-if-nil              -->  goto-X-if-non-nil
+	 ;; not goto-X-if-non-nil          -->  goto-X-if-nil
+	 ;;
+	 ;; it is wrong to do the same thing for the -else-pop variants.
+	 ;;
+	 ((and (eq 'byte-not (car lap0))
+	       (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil)))
+	  (byte-compile-log-lap "  not %s\t-->\t%s"
+				lap1
+				(cons
+				 (if (eq (car lap1) 'byte-goto-if-nil)
+				     'byte-goto-if-not-nil
+				   'byte-goto-if-nil)
+				 (cdr lap1)))
+	  (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
+			   'byte-goto-if-not-nil
+			 'byte-goto-if-nil))
+	  (setq lap (delq lap0 lap))
+	  (setq keep-going t))
+	 ;;
+	 ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
+	 ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
+	 ;;
+	 ;; it is wrong to do the same thing for the -else-pop variants.
+	 ;;
+	 ((and (memq (car lap0)
+                     '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX
+	       (eq 'byte-goto (car lap1))                      ; gotoY
+	       (eq (cdr lap0) lap2))                           ; TAG X
+	  (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
+			     'byte-goto-if-not-nil 'byte-goto-if-nil)))
+	    (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
+				  lap0 lap1 lap2
+				  (cons inverse (cdr lap1)) lap2)
+	    (setq lap (delq lap0 lap))
+	    (setcar lap1 inverse)
+	    (setq keep-going t)))
+	 ;;
+	 ;; const goto-if-* --> whatever
+	 ;;
+	 ((and (eq 'byte-constant (car lap0))
+	       (memq (car lap1) byte-conditional-ops)
+               ;; If the `byte-constant's cdr is not a cons cell, it has
+               ;; to be an index into the constant pool); even though
+               ;; it'll be a constant, that constant is not known yet
+               ;; (it's typically a free variable of a closure, so will
+               ;; only be known when the closure will be built at
+               ;; run-time).
+               (consp (cdr lap0)))
+	  (cond ((if (memq (car lap1) '(byte-goto-if-nil
+                                        byte-goto-if-nil-else-pop))
+                     (car (cdr lap0))
+                   (not (car (cdr lap0))))
+		 (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
+				       lap0 lap1)
+		 (setq rest (cdr rest)
+		       lap (delq lap0 (delq lap1 lap))))
+		(t
+		 (byte-compile-log-lap "  %s %s\t-->\t%s"
+				       lap0 lap1
+				       (cons 'byte-goto (cdr lap1)))
+		 (when (memq (car lap1) byte-goto-always-pop-ops)
+		   (setq lap (delq lap0 lap)))
+		 (setcar lap1 'byte-goto)))
+          (setq keep-going t))
+	 ;;
+	 ;; varref-X varref-X  -->  varref-X dup
+	 ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
+	 ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
+	 ;; We don't optimize the const-X variations on this here,
+	 ;; because that would inhibit some goto optimizations; we
+	 ;; optimize the const-X case after all other optimizations.
+	 ;;
+	 ((and (memq (car lap0) '(byte-varref byte-stack-ref))
+	       (progn
+		 (setq tmp (cdr rest))
+                 (setq tmp2 0)
+		 (while (eq (car (car tmp)) 'byte-dup)
+		   (setq tmp2 (1+ tmp2))
+                   (setq tmp (cdr tmp)))
+		 t)
+	       (eq (if (eq 'byte-stack-ref (car lap0))
+                       (+ tmp2 1 (cdr lap0))
+                     (cdr lap0))
+                   (cdr (car tmp)))
+	       (eq (car lap0) (car (car tmp))))
+	  (if (memq byte-optimize-log '(t byte))
+	      (let ((str ""))
+		(setq tmp2 (cdr rest))
+		(while (not (eq tmp tmp2))
+		  (setq tmp2 (cdr tmp2)
+			str (concat str " dup")))
+		(byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
+				      lap0 str lap0 lap0 str)))
+	  (setq keep-going t)
+	  (setcar (car tmp) 'byte-dup)
+	  (setcdr (car tmp) 0)
+	  (setq rest tmp))
+	 ;;
+	 ;; TAG1: TAG2: --> TAG1: <deleted>
+	 ;; (and other references to TAG2 are replaced with TAG1)
+	 ;;
+	 ((and (eq (car lap0) 'TAG)
+	       (eq (car lap1) 'TAG))
+	  (and (memq byte-optimize-log '(t byte))
+	       (byte-compile-log "  adjacent tags %d and %d merged"
+				 (nth 1 lap1) (nth 1 lap0)))
+	  (setq tmp3 lap)
+	  (while (setq tmp2 (rassq lap0 tmp3))
+	    (setcdr tmp2 lap1)
+	    (setq tmp3 (cdr (memq tmp2 tmp3))))
+	  (setq lap (delq lap0 lap)
+		keep-going t)
+          ;; replace references to tag in jump tables, if any
+          (dolist (table byte-compile-jump-tables)
+            (maphash #'(lambda (value tag)
+                         (when (equal tag lap0)
+                           (puthash value lap1 table)))
+                     table)))
+	 ;;
+	 ;; unused-TAG: --> <deleted>
+	 ;;
+	 ((and (eq 'TAG (car lap0))
+	       (not (rassq lap0 lap))
+               ;; make sure this tag isn't used in a jump-table
+               (cl-loop for table in byte-compile-jump-tables
+                        when (member lap0 (hash-table-values table))
+                        return nil finally return t))
+	  (and (memq byte-optimize-log '(t byte))
+	       (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
+	  (setq lap (delq lap0 lap)
+		keep-going t))
+	 ;;
+	 ;; goto   ... --> goto   <delete until TAG or end>
+	 ;; return ... --> return <delete until TAG or end>
+	 ;; (unless a jump-table is being used, where deleting may affect
+         ;; other valid case bodies)
+         ;;
+	 ((and (memq (car lap0) '(byte-goto byte-return))
+	       (not (memq (car lap1) '(TAG nil)))
+               ;; FIXME: Instead of deferring simply when jump-tables are
+               ;; being used, keep a list of tags used for switch tags and
+               ;; use them instead (see `byte-compile-inline-lapcode').
+               (not byte-compile-jump-tables))
+	  (setq tmp rest)
+	  (let ((i 0)
+		(opt-p (memq byte-optimize-log '(t lap)))
+		str deleted)
+	    (while (and (setq tmp (cdr tmp))
+			(not (eq 'TAG (car (car tmp)))))
+	      (if opt-p (setq deleted (cons (car tmp) deleted)
+			      str (concat str " %s")
+			      i (1+ i))))
+	    (if opt-p
+		(let ((tagstr
+		       (if (eq 'TAG (car (car tmp)))
+			   (format "%d:" (car (cdr (car tmp))))
+			 (or (car tmp) ""))))
+		  (if (< i 6)
+		      (apply 'byte-compile-log-lap-1
+			     (concat "  %s" str
+				     " %s\t-->\t%s <deleted> %s")
+			     lap0
+			     (nconc (nreverse deleted)
+				    (list tagstr lap0 tagstr)))
+		    (byte-compile-log-lap
+		     "  %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
+		     lap0 i (if (= i 1) "" "s")
+		     tagstr lap0 tagstr))))
+	    (rplacd rest tmp))
+	  (setq keep-going t))
+	 ;;
+	 ;; <safe-op> unbind --> unbind <safe-op>
+	 ;; (this may enable other optimizations.)
+	 ;;
+	 ((and (eq 'byte-unbind (car lap1))
+	       (memq (car lap0) byte-after-unbind-ops))
+	  (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
+	  (setcar rest lap1)
+	  (setcar (cdr rest) lap0)
+	  (setq keep-going t))
+	 ;;
+	 ;; varbind-X unbind-N         -->  discard unbind-(N-1)
+	 ;; save-excursion unbind-N    -->  unbind-(N-1)
+	 ;; save-restriction unbind-N  -->  unbind-(N-1)
+	 ;;
+	 ((and (eq 'byte-unbind (car lap1))
+	       (memq (car lap0) '(byte-varbind byte-save-excursion
+				  byte-save-restriction))
+	       (< 0 (cdr lap1)))
+	  (if (zerop (setcdr lap1 (1- (cdr lap1))))
+	      (delq lap1 rest))
+	  (if (eq (car lap0) 'byte-varbind)
+	      (setcar rest (cons 'byte-discard 0))
+	    (setq lap (delq lap0 lap)))
+	  (byte-compile-log-lap "  %s %s\t-->\t%s %s"
+		                lap0 (cons (car lap1) (1+ (cdr lap1)))
+		                (if (eq (car lap0) 'byte-varbind)
+		                    (car rest)
+		                  (car (cdr rest)))
+		                (if (and (/= 0 (cdr lap1))
+			                 (eq (car lap0) 'byte-varbind))
+			            (car (cdr rest))
+			          ""))
+	  (setq keep-going t))
+	 ;;
+	 ;; goto*-X ... X: goto-Y  --> goto*-Y
+	 ;; goto-X ...  X: return  --> return
+	 ;;
+	 ((and (memq (car lap0) byte-goto-ops)
+	       (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
+		     '(byte-goto byte-return)))
+	  (cond ((and (not (eq tmp lap0))
+		      (or (eq (car lap0) 'byte-goto)
+			  (eq (car tmp) 'byte-goto)))
+		 (byte-compile-log-lap "  %s [%s]\t-->\t%s"
+				       (car lap0) tmp tmp)
+		 (if (eq (car tmp) 'byte-return)
+		     (setcar lap0 'byte-return))
+		 (setcdr lap0 (cdr tmp))
+		 (setq keep-going t))))
+	 ;;
+	 ;; goto-*-else-pop X ... X: goto-if-* --> whatever
+	 ;; goto-*-else-pop X ... X: discard --> whatever
+	 ;;
+	 ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
+				  byte-goto-if-not-nil-else-pop))
+	       (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
+		     (eval-when-compile
+		       (cons 'byte-discard byte-conditional-ops)))
+	       (not (eq lap0 (car tmp))))
+	  (setq tmp2 (car tmp))
+	  (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
+					 byte-goto-if-nil)
+					(byte-goto-if-not-nil-else-pop
+					 byte-goto-if-not-nil))))
+	  (if (memq (car tmp2) tmp3)
+	      (progn (setcar lap0 (car tmp2))
+		     (setcdr lap0 (cdr tmp2))
+		     (byte-compile-log-lap "  %s-else-pop [%s]\t-->\t%s"
+					   (car lap0) tmp2 lap0))
+	    ;; Get rid of the -else-pop's and jump one step further.
+	    (or (eq 'TAG (car (nth 1 tmp)))
+		(setcdr tmp (cons (byte-compile-make-tag)
+				  (cdr tmp))))
+	    (byte-compile-log-lap "  %s [%s]\t-->\t%s <skip>"
+				  (car lap0) tmp2 (nth 1 tmp3))
+	    (setcar lap0 (nth 1 tmp3))
+	    (setcdr lap0 (nth 1 tmp)))
+	  (setq keep-going t))
+	 ;;
+	 ;; const goto-X ... X: goto-if-* --> whatever
+	 ;; const goto-X ... X: discard   --> whatever
+	 ;;
+	 ((and (eq (car lap0) 'byte-constant)
+	       (eq (car lap1) 'byte-goto)
+	       (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
+		     (eval-when-compile
+		       (cons 'byte-discard byte-conditional-ops)))
+	       (not (eq lap1 (car tmp))))
+	  (setq tmp2 (car tmp))
+	  (cond ((when (consp (cdr lap0))
+		   (memq (car tmp2)
+			 (if (null (car (cdr lap0)))
+			     '(byte-goto-if-nil byte-goto-if-nil-else-pop)
+			   '(byte-goto-if-not-nil
+			     byte-goto-if-not-nil-else-pop))))
+		 (byte-compile-log-lap "  %s goto [%s]\t-->\t%s %s"
+				       lap0 tmp2 lap0 tmp2)
+		 (setcar lap1 (car tmp2))
+		 (setcdr lap1 (cdr tmp2))
+		 ;; Let next step fix the (const,goto-if*) sequence.
+		 (setq rest (cons nil rest))
+		 (setq keep-going t))
+		((or (consp (cdr lap0))
+		     (eq (car tmp2) 'byte-discard))
+		 ;; Jump one step further
+		 (byte-compile-log-lap
+		  "  %s goto [%s]\t-->\t<deleted> goto <skip>"
+		  lap0 tmp2)
 		 (or (eq 'TAG (car (nth 1 tmp)))
 		     (setcdr tmp (cons (byte-compile-make-tag)
 				       (cdr tmp))))
-		 (byte-compile-log-lap "  %s [%s]\t-->\t%s <skip>"
-				       (car lap0) tmp2 (nth 1 tmp3))
-		 (setcar lap0 (nth 1 tmp3))
-		 (setcdr lap0 (nth 1 tmp)))
-	       (setq keep-going t))
-	      ;;
-	      ;; const goto-X ... X: goto-if-* --> whatever
-	      ;; const goto-X ... X: discard   --> whatever
-	      ;;
-	      ((and (eq (car lap0) 'byte-constant)
-		    (eq (car lap1) 'byte-goto)
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
-			  (eval-when-compile
-			    (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap1 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (cond ((when (consp (cdr lap0))
-		        (memq (car tmp2)
-			      (if (null (car (cdr lap0)))
-				  '(byte-goto-if-nil byte-goto-if-nil-else-pop)
-				'(byte-goto-if-not-nil
-				  byte-goto-if-not-nil-else-pop))))
-		      (byte-compile-log-lap "  %s goto [%s]\t-->\t%s %s"
-					    lap0 tmp2 lap0 tmp2)
-		      (setcar lap1 (car tmp2))
-		      (setcdr lap1 (cdr tmp2))
-		      ;; Let next step fix the (const,goto-if*) sequence.
-		      (setq rest (cons nil rest))
-		      (setq keep-going t))
-		     ((or (consp (cdr lap0))
-			  (eq (car tmp2) 'byte-discard))
-		      ;; Jump one step further
-		      (byte-compile-log-lap
-		       "  %s goto [%s]\t-->\t<deleted> goto <skip>"
-		       lap0 tmp2)
-		      (or (eq 'TAG (car (nth 1 tmp)))
-			  (setcdr tmp (cons (byte-compile-make-tag)
-					    (cdr tmp))))
-		      (setcdr lap1 (car (cdr tmp)))
-		      (setq lap (delq lap0 lap))
-		      (setq keep-going t))))
-	      ;;
-	      ;; X: varref-Y    ...     varset-Y goto-X  -->
-	      ;; X: varref-Y Z: ... dup varset-Y goto-Z
-	      ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
-	      ;; (This is so usual for while loops that it is worth handling).
-              ;;
-              ;; Here again, we could do it for stack-ref/stack-set, but
-	      ;; that's replacing a stack-ref-Y with a stack-ref-0, which
-              ;; is a very minor improvement (if any), at the cost of
-	      ;; more stack use and more byte-code.  Let's not do it.
-	      ;;
-	      ((and (eq (car lap1) 'byte-varset)
-		    (eq (car lap2) 'byte-goto)
-		    (not (memq (cdr lap2) rest)) ;Backwards jump
-		    (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
-			'byte-varref)
-		    (eq (cdr (car tmp)) (cdr lap1))
-		    (not (memq (car (cdr lap1)) byte-boolean-vars)))
-	       ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "  %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
-		  (nth 1 (cdr lap2)) (car tmp)
-                  lap1 lap2
-		  (nth 1 (cdr lap2)) (car tmp)
-		  (nth 1 newtag) 'byte-dup lap1
-		  (cons 'byte-goto newtag)
-		  )
-		 (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
-		 (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
-	       (setq add-depth 1)
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X Y: ... X: goto-if*-Y  -->  goto-if-not-*-X+1 Y:
-	      ;; (This can pull the loop test to the end of the loop)
-	      ;;
-	      ((and (eq (car lap0) 'byte-goto)
-		    (eq (car lap1) 'TAG)
-		    (eq lap1
-			(cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
-		    (memq (car (car tmp))
-			  '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-				      byte-goto-if-nil-else-pop)))
-;;	       (byte-compile-log-lap "  %s %s, %s %s  --> moved conditional"
-;;				     lap0 lap1 (cdr lap0) (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "%s %s: ... %s: %s\t-->\t%s ... %s:"
-		  lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
-		  (cons (cdr (assq (car (car tmp))
-				   '((byte-goto-if-nil . byte-goto-if-not-nil)
-				     (byte-goto-if-not-nil . byte-goto-if-nil)
-				     (byte-goto-if-nil-else-pop .
-				      byte-goto-if-not-nil-else-pop)
-				     (byte-goto-if-not-nil-else-pop .
-				      byte-goto-if-nil-else-pop))))
-			newtag)
-
-		  (nth 1 newtag)
-		  )
-		 (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
-		 (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
-		     ;; We can handle this case but not the -if-not-nil case,
-		     ;; because we won't know which non-nil constant to push.
-		   (setcdr rest (cons (cons 'byte-constant
-					    (byte-compile-get-constant nil))
-				      (cdr rest))))
-	       (setcar lap0 (nth 1 (memq (car (car tmp))
-					 '(byte-goto-if-nil-else-pop
-					   byte-goto-if-not-nil
-					   byte-goto-if-nil
-					   byte-goto-if-not-nil
-					   byte-goto byte-goto))))
-	       )
-	       (setq keep-going t))
-	      )
+		 (setcdr lap1 (car (cdr tmp)))
+		 (setq lap (delq lap0 lap))
+		 (setq keep-going t))))
+	 ;;
+	 ;; X: varref-Y    ...     varset-Y goto-X  -->
+	 ;; X: varref-Y Z: ... dup varset-Y goto-Z
+	 ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
+	 ;; (This is so usual for while loops that it is worth handling).
+         ;;
+         ;; Here again, we could do it for stack-ref/stack-set, but
+	 ;; that's replacing a stack-ref-Y with a stack-ref-0, which
+         ;; is a very minor improvement (if any), at the cost of
+	 ;; more stack use and more byte-code.  Let's not do it.
+	 ;;
+	 ((and (eq (car lap1) 'byte-varset)
+	       (eq (car lap2) 'byte-goto)
+	       (not (memq (cdr lap2) rest)) ;Backwards jump
+	       (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
+		   'byte-varref)
+	       (eq (cdr (car tmp)) (cdr lap1))
+	       (not (memq (car (cdr lap1)) byte-boolean-vars)))
+	  ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
+	  (let ((newtag (byte-compile-make-tag)))
+	    (byte-compile-log-lap
+	     "  %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
+	     (nth 1 (cdr lap2)) (car tmp)
+             lap1 lap2
+	     (nth 1 (cdr lap2)) (car tmp)
+	     (nth 1 newtag) 'byte-dup lap1
+	     (cons 'byte-goto newtag)
+	     )
+	    (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
+	    (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
+	  (setq add-depth 1)
+	  (setq keep-going t))
+	 ;;
+	 ;; goto-X Y: ... X: goto-if*-Y  -->  goto-if-not-*-X+1 Y:
+	 ;; (This can pull the loop test to the end of the loop)
+	 ;;
+	 ((and (eq (car lap0) 'byte-goto)
+	       (eq (car lap1) 'TAG)
+	       (eq lap1
+		   (cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
+	       (memq (car (car tmp))
+		     '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
+		       byte-goto-if-nil-else-pop)))
+	  ;;	       (byte-compile-log-lap "  %s %s, %s %s  --> moved conditional"
+	  ;;				     lap0 lap1 (cdr lap0) (car tmp))
+	  (let ((newtag (byte-compile-make-tag)))
+	    (byte-compile-log-lap
+	     "%s %s: ... %s: %s\t-->\t%s ... %s:"
+	     lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
+	     (cons (cdr (assq (car (car tmp))
+			      '((byte-goto-if-nil . byte-goto-if-not-nil)
+				(byte-goto-if-not-nil . byte-goto-if-nil)
+				(byte-goto-if-nil-else-pop .
+				                           byte-goto-if-not-nil-else-pop)
+				(byte-goto-if-not-nil-else-pop .
+				                               byte-goto-if-nil-else-pop))))
+		   newtag)
+
+	     (nth 1 newtag)
+	     )
+	    (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
+	    (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
+		;; We can handle this case but not the -if-not-nil case,
+		;; because we won't know which non-nil constant to push.
+		(setcdr rest (cons (cons 'byte-constant
+					 (byte-compile-get-constant nil))
+				   (cdr rest))))
+	    (setcar lap0 (nth 1 (memq (car (car tmp))
+				      '(byte-goto-if-nil-else-pop
+					byte-goto-if-not-nil
+					byte-goto-if-nil
+					byte-goto-if-not-nil
+					byte-goto byte-goto))))
+	    )
+	  (setq keep-going t))
+
+	 ;;
+	 ;; stack-set-M [discard/discardN ...]  -->  discardN-preserve-tos
+	 ;; stack-set-M [discard/discardN ...]  -->  discardN
+	 ;;
+	 ((and (eq (car lap0) 'byte-stack-set)
+	       (memq (car lap1) '(byte-discard byte-discardN))
+	       (progn
+	         ;; See if enough discard operations follow to expose or
+	         ;; destroy the value stored by the stack-set.
+	         (setq tmp (cdr rest))
+	         (setq tmp2 (1- (cdr lap0)))
+	         (setq tmp3 0)
+	         (while (memq (car (car tmp)) '(byte-discard byte-discardN))
+	           (setq tmp3
+                         (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
+                                     1
+                                   (cdr (car tmp)))))
+	           (setq tmp (cdr tmp)))
+	         (>= tmp3 tmp2)))
+	  ;; Do the optimization.
+	  (setq lap (delq lap0 lap))
+          (setcar lap1
+                  (if (= tmp2 tmp3)
+                      ;; The value stored is the new TOS, so pop one more
+                      ;; value (to get rid of the old value) using the
+                      ;; TOS-preserving discard operator.
+                      'byte-discardN-preserve-tos
+                    ;; Otherwise, the value stored is lost, so just use a
+                    ;; normal discard.
+                    'byte-discardN))
+          (setcdr lap1 (1+ tmp3))
+	  (setcdr (cdr rest) tmp)
+	  (byte-compile-log-lap "  %s [discard/discardN]...\t-->\t%s"
+	                        lap0 lap1))
+
+	 ;;
+	 ;; discardN-preserve-tos return  -->  return
+	 ;; dup return  -->  return
+	 ;; stack-set-N return  -->  return     ; where N is TOS-1
+	 ;;
+	 ((and (eq (car lap1) 'byte-return)
+	       (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
+	           (and (eq (car lap0) 'byte-stack-set)
+	                (= (cdr lap0) 1))))
+	  (setq keep-going t)
+	  ;; The byte-code interpreter will pop the stack for us, so
+	  ;; we can just leave stuff on it.
+	  (setq lap (delq lap0 lap))
+	  (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 lap1))
+
+	 ;;
+	 ;; goto-X ... X: discard  ==>  discard goto-Y ... X: discard Y:
+	 ;;
+	 ((and (eq (car lap0) 'byte-goto)
+	       (setq tmp (cdr (memq (cdr lap0) lap)))
+	       (memq (caar tmp) '(byte-discard byte-discardN
+	                          byte-discardN-preserve-tos)))
+	  (byte-compile-log-lap
+	   "  goto-X .. X: \t-->\t%s goto-X.. X: %s Y:"
+	   (car tmp) (car tmp))
+	  (setq keep-going t)
+	  (let* ((newtag (byte-compile-make-tag))
+	         ;; Make a copy, since we sometimes modify insts in-place!
+	         (newdiscard (cons (caar tmp) (cdar tmp)))
+	         (newjmp (cons (car lap0) newtag)))
+	    (push newtag (cdr tmp))     ;Push new tag after the discard.
+	    (setcar rest newdiscard)
+	    (push newjmp (cdr rest))))
+
+	 ;;
+	 ;; const discardN-preserve-tos ==> discardN const
+	 ;;
+	 ((and (eq (car lap0) 'byte-constant)
+	       (eq (car lap1) 'byte-discardN-preserve-tos))
+	  (setq keep-going t)
+	  (let ((newdiscard (cons 'byte-discardN (cdr lap1))))
+	    (byte-compile-log-lap
+	     "  %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0)
+	    (setf (car rest) newdiscard)
+	    (setf (cadr rest) lap0)))
+	 )
 	(setq rest (cdr rest)))
       )
     ;; Cleanup stage:
@@ -2085,41 +2168,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
 
 	    ;;
-	    ;; stack-set-M [discard/discardN ...]  -->  discardN-preserve-tos
-	    ;; stack-set-M [discard/discardN ...]  -->  discardN
-	    ;;
-	    ((and (eq (car lap0) 'byte-stack-set)
-	          (memq (car lap1) '(byte-discard byte-discardN))
-	          (progn
-	            ;; See if enough discard operations follow to expose or
-	            ;; destroy the value stored by the stack-set.
-	            (setq tmp (cdr rest))
-	            (setq tmp2 (1- (cdr lap0)))
-	            (setq tmp3 0)
-	            (while (memq (car (car tmp)) '(byte-discard byte-discardN))
-	              (setq tmp3
-                            (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
-                                        1
-                                      (cdr (car tmp)))))
-	              (setq tmp (cdr tmp)))
-	            (>= tmp3 tmp2)))
-	     ;; Do the optimization.
-	     (setq lap (delq lap0 lap))
-             (setcar lap1
-                     (if (= tmp2 tmp3)
-                         ;; The value stored is the new TOS, so pop one more
-                         ;; value (to get rid of the old value) using the
-                         ;; TOS-preserving discard operator.
-                         'byte-discardN-preserve-tos
-                       ;; Otherwise, the value stored is lost, so just use a
-                       ;; normal discard.
-                       'byte-discardN))
-             (setcdr lap1 (1+ tmp3))
-	     (setcdr (cdr rest) tmp)
-	     (byte-compile-log-lap "  %s [discard/discardN]...\t-->\t%s"
-	        		   lap0 lap1))
-
-	    ;;
 	    ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y  -->
 	    ;; discardN-(X+Y)
 	    ;;
@@ -2146,20 +2194,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	     (setq lap (delq lap0 lap))
 	     (setcdr lap1 (+ (cdr lap0) (cdr lap1)))
 	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 (car rest)))
-
-	    ;;
-	    ;; discardN-preserve-tos return  -->  return
-	    ;; dup return  -->  return
-	    ;; stack-set-N return  -->  return     ; where N is TOS-1
-	    ;;
-	    ((and (eq (car lap1) 'byte-return)
-	          (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
-	              (and (eq (car lap0) 'byte-stack-set)
-	        	   (= (cdr lap0) 1))))
-	     ;; The byte-code interpreter will pop the stack for us, so
-	     ;; we can just leave stuff on it.
-	     (setq lap (delq lap0 lap))
-	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 lap1))
             )
       (setq rest (cdr rest)))
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))