New branch for lexbind, losing all history.

This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original
lexbind branch.

10 files changed, 1907 insertions, 307 deletions

diff --git a/lisp/ChangeLog.funvec b/lisp/ChangeLog.funvec
new file mode 100644
index 00000000000..0a31b9a590f
--- /dev/null
+++ b/lisp/ChangeLog.funvec
@@ -0,0 +1,10 @@
+2004-05-20  Miles Bader  <miles@gnu.org>
+
+        * subr.el (functionp): Use `funvecp' instead of
+        `byte-compiled-function-p'.
+        * help-fns.el (describe-function-1): Describe curried functions
+        and other funvecs as such.
+        (help-highlight-arguments): Only format things that look like a
+        function.
+
+;; arch-tag: 87f75aac-de53-40d7-96c7-3befaa771cb1
diff --git a/lisp/ChangeLog.lexbind b/lisp/ChangeLog.lexbind
new file mode 100644
index 00000000000..ca491f961d7
--- /dev/null
+++ b/lisp/ChangeLog.lexbind
@@ -0,0 +1,256 @@
+2006-12-04  Miles Bader  <miles@gnu.org>
+
+        * Makefile.in (COMPILE_FIRST_STACK_DEPTH): New variable.
+        (compile, compile-always): Use it.
+
+2005-10-24  Miles Bader  <miles@gnu.org>
+
+        * subr.el (functionp): Re-remove.
+
+        * emacs-lisp/bytecomp.el (byte-compile-closure): Add optional
+        ADD-LAMBDA argument, which we just pass to `byte-compile-lambda'.
+        (byte-compile-defun): Use ADD-LAMBDA arg to `byte-compile-closure'
+        instead of adding lambda ourselves.
+        
+2004-08-09  Miles Bader  <miles@gnu.org>
+
+        Changes from merging the funvec patch:
+
+        * emacs-lisp/bytecomp.el (byte-compile-make-closure): Use `curry'
+        instead of `vector' to create compiled closures.
+
+        Merge funvec patch.
+
+2004-04-29  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/bytecomp.el (byte-compile-top-level): Add new entries
+        to `byte-compile-lexical-environment' at the start, not end.
+        (byte-compile-delay-out): Correctly default STACK-ADJUST to zero.
+
+        * emacs-lisp/byte-opt.el (byte-opt-update-stack-params): Don't
+        crash on no-op lapcode entries (car is nil).
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-make-lambda-lexenv):
+        Push a lexvar onto lexenv, not a vinfo!
+
+2004-04-11  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/bytecomp.el (byte-compile-top-level): Correctly
+        analyze lexically-bound arguments.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze):
+        Use `append' instead of `nconc'.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-make-lvarinfo): Don't
+        use backquote to make a mutable data-structure.
+        (byte-compile-lvarinfo-num-refs, byte-compile-lvarinfo-num-sets):
+        Renamed to use `num-' instead of `num'.
+        (byte-compile-make-lambda-lexenv): Adjusted accordingly.
+
+2004-04-10  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo):
+        Look at variable's global specialp state too.
+
+2004-04-09  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Default
+        initial-stack-depth to 0.
+        (byte-optimize-lapcode): Discard the right number of values in
+        the stack-set+discard-->discard optimization.
+
+2004-04-02  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Setup the lexical
+        environment if lexical-binding is enabled.
+
+2003-10-14  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/macroexp.el (macroexpand-all-1): Special-case
+        `backquote-list*' to avoid stack overflows.
+
+2003-04-04  Miles Bader  <miles@gnu.org>
+
+        * help-fns.el (help-function-arglist): Handle interpreted closures.
+
+2002-11-20  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/bytecomp.el (byte-compile-stack-adjustment):
+        Correctly handle discardN* operators.
+        * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Fix stack-depth
+        tracking errors.
+
+2002-08-26  Miles Bader  <miles@gnu.org>
+
+        * international/mule.el (make-char): Macroexpand call to
+        charset-id constructed by `byte-compile' hook.
+
+        * emacs-lisp/macroexp.el (macroexpand-all-1): Expand defconst value.
+
+        * emacs-lisp/byte-opt.el (byte-opt-update-stack-params): New macro.
+        (byte-optimize-lapcode): Keep track of stack-depth in final pass too.
+        Add more optimizations for lexical binding.
+        (byte-compile-inline-expand): Macroexpand result of inlining.
+
+        * emacs-lisp/bytecomp.el (byte-compile-lambda): Update call to
+        byte-compile-closure-initial-lexenv-p.
+        (byte-discardN-preserve-tos): Alias to byte-discardN.
+        (byte-compile-push-binding-init): Don't push unused variables on
+        init-lexenv.
+        (byte-compile-push-binding-init): Don't use LFORMINFO if it's nil.
+        (byte-compile-lambda): Don't look at lexical environment unless
+        we're using lexical binding.
+        (byte-compile-defmacro): Correctly generate macros.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-unbind): Optimize the
+        dynamic-bindings-only case.
+        (byte-compile-bind): Don't special-case unused lexical variables.
+
+        * emacs-lisp/disass.el (disassemble-1): Print arg for discardN ops.
+
+2002-08-19  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Handle
+        `byte-discardN-preserve-tos' pseudo-op.
+        (byte-compile-side-effect-and-error-free-ops): Add `byte-stack-ref'.
+        (byte-compile-side-effect-free-ops): Add `byte-vec-ref'.
+        (byte-optimize-lapcode): Add some cases for stack-set/ref ops.
+        Add tracking of stack-depth.  Unfinished code to collapse
+        lexical-unbinding sequences.
+
+        * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle
+        `byte-discardN-preserve-tos' pseudo-op.
+        (byte-compile-top-level): If there are lexical args, output a TAG
+        op to record the initial stack-depth for the optimizer.
+
+2002-08-17  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/bytecomp.el (byte-discardN): Add byte-defop.
+        (byte-compile-lapcode): Include byte-discardN.
+        (byte-compile-lambda): Fixup closure detection.
+        (byte-compile-top-level): Handle arguments for a lexical lambda.
+        (byte-compile-lexical-variable-ref, byte-compile-variable-ref)
+        (byte-compile-variable-set): Use byte-compile-stack-set/ref.
+        (byte-compile-discard): Add new parameters NUM and PRESERVE-TOS.
+        (byte-compile-stack-ref, byte-compile-stack-set): New functions.
+        (byte-compile-push-binding-init): Get the variable list properly
+        from LFORMINFO.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze):
+        Ignore setq'd variables we're not interested in.
+        (byte-compile-make-lambda-lexenv): Add assertion that closed-over
+        variables be heap allocated.
+        (byte-compile-closure-initial-lexenv-p): Renamed from
+        byte-compile-closure-lexenv-p.
+        (byte-compile-non-stack-bindings-p): Get the variable list
+        properly from LFORMINFO.
+        (byte-compile-maybe-push-heap-environment): Handle the
+        no-closed-over-variables case correctly.
+        (byte-compile-bind): Use byte-compile-stack-set/ref.
+        Don't bother modifying INIT-LEXENV as no one will see the changes.
+        (byte-compile-unbind): Call `byte-compile-discard' to handle
+        unbinding lexical bindings.
+
+        * emacs-lisp/disass.el (disassemble-internal): Handle closures.
+        (disassemble-1): Handle new bytecodes.
+        * emacs-lisp/byte-opt.el (disassemble-offset): Handle new bytecodes.
+
+2002-06-16  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/macroexp.el (macroexp-accumulate): New macro.
+        (macroexpand-all-forms, macroexpand-all-clauses): Use it.
+        * Makefile.in (compile): Undo previous change.
+
+2002-06-14  Miles Bader  <miles@gnu.org>
+
+        * Makefile.in (COMPILE_FIRST): Add `emacs-lisp/macroexp.el'.
+        (compile): Add a special case that compiles `emacs-lisp/macroexp.el'
+        with an increased max-lisp-eval-depth.
+
+        * emacs-lisp/bytecomp.el: Provide `bytecomp-preload', at the
+        beginning of the file.  Require `byte-lexbind' at compile time.
+        Add a few doc string.
+        (byte-compile-push-bytecodes)
+        (byte-compile-push-bytecode-const2): New macros.
+        (byte-compile-lapcode): Use them.  Do general code cleanup.
+        (byte-compile-initial-macro-environment): Expand macros in
+        byte-compile-eval before passing to byte-compile-top-level.
+        (byte-compile): Use the `byte-compile-initial-macro-environment'.
+
+        * emacs-lisp/byte-lexbind.el: Require `bytecomp-preload' instead of
+        `bytecomp'.
+        (byte-compile-bind): Use `byte-compile-dynamic-variable-bind' to bind
+        dynamic variables.
+        (byte-compile-maybe-push-heap-environment): Fix function name typo.
+
+2002-06-13  Miles Bader  <miles@gnu.org>
+
+        Byte compiler lexical binding support (not finished yet):
+        * emacs-lisp/bytecomp.el: Require `macroexp'.
+        (byte-compile-lexical-environment) 
+        (byte-compile-current-heap-environment) 
+        (byte-compile-current-num-closures): New variables.
+        (0, 178, 179, 180, 181): New byte-opcodes.
+        (byte-compile-lapcode): Handle stack-ref/set opcodes.  Signal an
+        error if a delay-output placeholder is not filled in yet.
+        (byte-compile-file-form, byte-compile): Expand all macros with
+        `macroexpand-all'.
+        (byte-compile-file-form-defsubst, byte-compile-form): Don't expand
+        macros here.
+        (byte-compile-make-lambda-lexenv): Autoload.
+        (byte-compile-lambda): Initial code for handling lexically-bound
+        arguments and closures; doesn't work yet.
+        (byte-compile-closure-code-p, byte-compile-make-closure) 
+        (byte-compile-closure): New functions.
+        (byte-compile-check-variable, byte-compile-dynamic-variable-op) 
+        (byte-compile-dynamic-variable-bind) 
+        (byte-compile-lexical-variable-ref, byte-compile-variable-set): 
+        New functions.
+        (byte-compile-variable-ref): Remove second argument.  Now only
+        handles real variable references (not setting or binding).
+        (byte-compile-push-unknown-constant) 
+        (byte-compile-resolve-unknown-constant): New functions.
+        (byte-compile-funarg, byte-compile-funarg-2): Functions removed.
+        (byte-compile-function-form): Use either `byte-compile-constant'
+        or `byte-compile-closure'.
+        (byte-compile-setq): Use `byte-compile-variable-set' instead of
+        `byte-compile-variable-ref'.
+        (apply, mapcar, mapatoms, mapconcat, mapc, sort):
+        `byte-defop-compiler-1's removed.
+        (byte-compile-while): Make sure lexically-bound variables inside
+        the loop don't get stored in an environment outside the loop.
+        (byte-compile-compute-lforminfo): Autoload.
+        (byte-compile-push-binding-init): New function.
+        (byte-compile-let, byte-compile-let*): Handle lexical binding.
+        (byte-compile-defun): Use `byte-compile-closure' to do the work.
+        (byte-compile-defmacro): Use `byte-compile-make-closure'.
+        (byte-compile-defvar): Expand the generated call to `push' since
+        we're past macroexpansion already.
+        (byte-compile-stack-adjustment): New function.
+        (byte-compile-out): Make second arg optional.  Rewrite for clarity.
+        (byte-compile-delay-out, byte-compile-delayed-out): New functions.
+
+        * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't
+        expand macros here.
+
+        * emacs-lisp/macroexp.el (macroexpand-all-1): Expand defmacro forms.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-make-lvarinfo) 
+        (byte-compile-lforminfo-add-var) 
+        (byte-compile-lforminfo-note-closure) 
+        (byte-compile-compute-lforminfo) 
+        (byte-compile-lforminfo-from-lambda) 
+        (byte-compile-lforminfo-analyze) 
+        (byte-compile-heapenv-add-accessible-env) 
+        (byte-compile-heapenv-ensure-access) 
+        (byte-compile-rearrange-let-clauses, byte-compile-bind) 
+        (byte-compile-unbind): Fix a bunch of typos.
+
+2002-06-12  Miles Bader  <miles@gnu.org>
+
+        * emacs-lisp/byte-lexbind.el, emacs-lisp/macroexp.el: New files.
+
+        * subr.el (functionp): Function removed (now a subr).
+        * help-fns.el (describe-function-1): Handle interpreted closures.
+
+;; arch-tag: bd1b5b8b-fdb2-425d-9ac2-20689fb0ee70
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 4effdddff6a..25f7b89c9db 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -71,6 +71,13 @@ AUTOGENEL = loaddefs.el \
         cedet/ede/loaddefs.el \
         cedet/srecode/loaddefs.el
 
+# Value of max-lisp-eval-depth when compiling initially.
+# During bootstrapping the byte-compiler is run interpreted when compiling
+# itself, and uses more stack than usual.
+#
+BIG_STACK_DEPTH = 1000
+BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
+
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.
 
@@ -195,7 +202,7 @@ compile-onefile:
         @echo Compiling $(THEFILE)
         @# Use byte-compile-refresh-preloaded to try and work around some of
         @# the most common bootstrapping problems.
-        @$(emacs) -l bytecomp -f byte-compile-refresh-preloaded $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE)
+        @$(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE)
 
 # Files MUST be compiled one by one. If we compile several files in a
 # row (i.e., in the same instance of Emacs) we can't make sure that
diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el
new file mode 100644
index 00000000000..a01829abf50
--- /dev/null
+++ b/lisp/emacs-lisp/byte-lexbind.el
@@ -0,0 +1,696 @@
+;;; byte-lexbind.el --- Lexical binding support for byte-compiler
+;;
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;;
+;; Author: Miles Bader <miles@gnu.org>
+;; Keywords: lisp, compiler, lexical binding
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'bytecomp-preload "bytecomp")
+
+;; Downward closures aren't implemented yet, so this should always be nil
+(defconst byte-compile-use-downward-closures nil
+  "If true, use `downward closures', which are closures that don't cons.")
+
+(defconst byte-compile-save-window-excursion-uses-eval t
+  "If true, the bytecode for `save-window-excursion' uses eval.
+This means that the body of the form must be put into a closure.")
+
+(defun byte-compile-arglist-vars (arglist)
+  "Return a list of the variables in the lambda argument list ARGLIST."
+  (remq '&rest (remq '&optional arglist)))
+
+
+;;; Variable extent analysis.
+
+;; A `lforminfo' holds information about lexical bindings in a form, and some
+;; other info for analysis.  It is a cons-cell, where the car is a list of
+;; `lvarinfo' stuctures, which form an alist indexed by variable name, and the
+;; cdr is the number of closures found in the form:
+;;
+;;   LFORMINFO : ((LVARINFO ...) . NUM-CLOSURES)"
+;;
+;; A `lvarinfo' holds information about a single lexical variable.  It is a
+;; list whose car is the variable name (so an lvarinfo is suitable as an alist
+;; entry), and the rest of the of which holds information about the variable:
+;;
+;;   LVARINFO : (VAR NUM-REFS NUM-SETS CLOSED-OVER)
+;;
+;; NUM-REFS is the number of times the variable's value is used
+;; NUM-SETS is the number of times the variable's value is set
+;; CLOSED-OVER is non-nil if the variable is referenced
+;;     anywhere but in its original function-level"
+
+;;; lvarinfo:
+
+;; constructor
+(defsubst byte-compile-make-lvarinfo (var &optional already-set)
+  (list var 0 (if already-set 1 0) 0 nil))
+;; accessors
+(defsubst byte-compile-lvarinfo-var (vinfo) (car vinfo))
+(defsubst byte-compile-lvarinfo-num-refs (vinfo) (cadr vinfo))
+(defsubst byte-compile-lvarinfo-num-sets (vinfo) (nth 3 vinfo))
+(defsubst byte-compile-lvarinfo-closed-over-p (vinfo) (nth 4 vinfo))
+;; setters
+(defsubst byte-compile-lvarinfo-note-ref (vinfo)
+  (setcar (cdr vinfo) (1+ (cadr vinfo))))
+(defsubst byte-compile-lvarinfo-note-set (vinfo)
+  (setcar (cddr vinfo) (1+ (nth 3 vinfo))))
+(defsubst byte-compile-lvarinfo-note-closure (vinfo)
+  (setcar (nthcdr 4 vinfo) t))
+
+;;; lforminfo:
+
+;; constructor
+(defsubst byte-compile-make-lforminfo ()
+  (cons nil 0))
+;; accessors
+(defalias 'byte-compile-lforminfo-vars 'car)
+(defalias 'byte-compile-lforminfo-num-closures 'cdr)
+;; setters
+(defsubst byte-compile-lforminfo-add-var (finfo var &optional already-set)
+  (setcar finfo (cons (byte-compile-make-lvarinfo var already-set)
+                      (car finfo))))
+
+(defun byte-compile-lforminfo-make-closure-flag ()
+  "Return a new `closure-flag'."
+  (cons nil nil))
+
+(defsubst byte-compile-lforminfo-note-closure (lforminfo lvarinfo closure-flag)
+  "If a variable reference or definition is inside a closure, record that fact.
+LFORMINFO describes the form currently being analyzed, and LVARINFO
+describes the variable.  CLOSURE-FLAG is either nil, if currently _not_
+inside a closure, and otherwise a `closure flag' returned by
+`byte-compile-lforminfo-make-closure-flag'."
+  (when closure-flag
+    (byte-compile-lvarinfo-note-closure lvarinfo)
+    (unless (car closure-flag)
+      (setcdr lforminfo (1+ (cdr lforminfo)))
+      (setcar closure-flag t))))
+
+(defun byte-compile-compute-lforminfo (form &optional special)
+  "Return information about variables lexically bound by FORM.
+SPECIAL is a list of variables that are special, and so shouldn't be
+bound lexically (in addition to variable that are considered special
+because they are declared with `defvar', et al).
+
+The result is an `lforminfo' data structure."
+  (and
+   (consp form)
+   (let ((lforminfo (byte-compile-make-lforminfo)))
+     (cond ((eq (car form) 'let)
+            ;; Find the bound variables
+            (dolist (clause (cadr form))
+              (let ((var (if (consp clause) (car clause) clause)))
+                (unless (or (specialp var) (memq var special))
+                  (byte-compile-lforminfo-add-var lforminfo var t))))
+            ;; Analyze the body
+            (unless (null (byte-compile-lforminfo-vars lforminfo))
+              (byte-compile-lforminfo-analyze-forms lforminfo form 2
+                                                    special nil)))
+           ((eq (car form) 'let*)
+            (dolist (clause (cadr form))
+              (let ((var (if (consp clause) (car clause) clause)))
+                ;; Analyze each initializer based on the previously
+                ;; bound variables.
+                (when (and (consp clause) lforminfo)
+                  (byte-compile-lforminfo-analyze lforminfo (cadr clause)
+                                                  special nil))
+                (unless (or (specialp var) (memq var special))
+                  (byte-compile-lforminfo-add-var lforminfo var t))))
+            ;; Analyze the body
+            (unless (null (byte-compile-lforminfo-vars lforminfo))
+              (byte-compile-lforminfo-analyze-forms lforminfo form 2
+                                                    special nil)))
+           ((eq (car form) 'condition-case)
+            ;; `condition-case' currently must dynamically bind the
+            ;; error variable, so do nothing.
+            )
+           ((memq (car form) '(defun defmacro))
+            (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special))
+           ((eq (car form) 'lambda)
+            (byte-compile-lforminfo-from-lambda lforminfo form special))
+           ((and (consp (car form)) (eq (caar form) 'lambda))
+            ;; An embedded lambda, which is basically just a `let'
+            (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special)))
+     (if (byte-compile-lforminfo-vars lforminfo)
+         lforminfo
+       nil))))
+
+(defun byte-compile-lforminfo-from-lambda (lforminfo lambda special)
+  "Initialize LFORMINFO from the lambda expression LAMBDA.
+SPECIAL is a list of variables to ignore.
+The first element of LAMBDA is ignored; it need not actually be `lambda'."
+  ;; Add the arguments
+  (dolist (arg (byte-compile-arglist-vars (cadr lambda)))
+    (byte-compile-lforminfo-add-var lforminfo arg t))
+  ;; Analyze the body
+  (unless (null (byte-compile-lforminfo-vars lforminfo))
+    (byte-compile-lforminfo-analyze-forms lforminfo lambda 2 special nil)))
+
+(defun byte-compile-lforminfo-analyze (lforminfo form &optional ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing FORM.
+IGNORE is a list of variables that shouldn't be analyzed (usually because
+they're special, or because some inner binding shadows the version in
+LFORMINFO).  CLOSURE-FLAG should be either nil or a `closure flag' created
+with `byte-compile-lforminfo-make-closure-flag'; the latter indicates that
+FORM is inside a lambda expression that may close over some variable in
+LFORMINFO."
+  (cond ((symbolp form)
+         ;; variable reference
+         (unless (member form ignore)
+           (let ((vinfo (assq form (byte-compile-lforminfo-vars lforminfo))))
+             (when vinfo
+               (byte-compile-lvarinfo-note-ref vinfo)
+               (byte-compile-lforminfo-note-closure lforminfo vinfo
+                                                    closure-flag)))))
+        ;; function call/special form
+        ((consp form)
+         (let ((fun (car form)))
+           (cond
+            ((eq fun 'setq)
+             (pop form)
+             (while form
+               (let ((var (pop form)))
+                 (byte-compile-lforminfo-analyze lforminfo (pop form)
+                                                 ignore closure-flag)
+                 (unless (member var ignore)
+                   (let ((vinfo
+                          (assq var (byte-compile-lforminfo-vars lforminfo))))
+                     (when vinfo
+                       (byte-compile-lvarinfo-note-set vinfo)
+                       (byte-compile-lforminfo-note-closure lforminfo vinfo
+                                                            closure-flag)))))))
+            ((eq fun 'catch)
+             ;; tag
+             (byte-compile-lforminfo-analyze lforminfo (cadr form)
+                                             ignore closure-flag)
+             ;; `catch' uses a closure for the body
+             (byte-compile-lforminfo-analyze-forms
+              lforminfo form 2
+              ignore
+              (or closure-flag
+                  (and (not byte-compile-use-downward-closures)
+                       (byte-compile-lforminfo-make-closure-flag)))))
+            ((eq fun 'cond)
+             (byte-compile-lforminfo-analyze-clauses lforminfo (cdr form) 0
+                                                     ignore closure-flag))
+            ((eq fun 'condition-case)
+             ;; `condition-case' separates its body/handlers into
+             ;; separate closures.
+             (unless (or closure-flag byte-compile-use-downward-closures)
+               ;; condition case is implemented by calling a function
+               (setq closure-flag (byte-compile-lforminfo-make-closure-flag)))
+             ;; value form
+             (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
+                                             ignore closure-flag)
+             ;; the error variable is always bound dynamically (because
+             ;; of the implementation)
+             (when (cadr form)
+               (push (cadr form) ignore))
+             ;; handlers
+             (byte-compile-lforminfo-analyze-clauses lforminfo
+                                                     (nthcdr 2 form) 1
+                                                     ignore closure-flag))
+            ((eq fun '(defvar defconst))
+             (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
+                                             ignore closure-flag))
+            ((memq fun '(defun defmacro))
+             (byte-compile-lforminfo-analyze-forms lforminfo form 3
+                                                   ignore closure-flag))
+            ((eq fun 'function)
+             ;; Analyze an embedded lambda expression [note: we only recognize
+             ;; it within (function ...) as the (lambda ...) for is actually a
+             ;; macro returning (function (lambda ...))].
+             (when (and (consp (cadr form)) (eq (car (cadr form)) 'lambda))
+               ;; shadow bound variables
+               (setq ignore
+                     (append (byte-compile-arglist-vars (cadr (cadr form)))
+                             ignore))
+               ;; analyze body of lambda
+               (byte-compile-lforminfo-analyze-forms
+                lforminfo (cadr form) 2
+                ignore
+                (or closure-flag
+                    (byte-compile-lforminfo-make-closure-flag)))))
+            ((eq fun 'let)
+             ;; analyze variable inits
+             (byte-compile-lforminfo-analyze-clauses lforminfo (cadr form) 1
+                                                     ignore closure-flag)
+             ;; shadow bound variables
+             (dolist (clause (cadr form))
+               (push (if (symbolp clause) clause (car clause))
+                     ignore))
+             ;; analyze body
+             (byte-compile-lforminfo-analyze-forms lforminfo form 2
+                                                   ignore closure-flag))
+            ((eq fun 'let*)
+             (dolist (clause (cadr form))
+               (if (symbolp clause)
+                   ;; shadow bound (to nil) variable
+                   (push clause ignore)
+                 ;; analyze variable init
+                 (byte-compile-lforminfo-analyze lforminfo (cadr clause)
+                                                 ignore closure-flag)
+                 ;; shadow bound variable
+                 (push (car clause) ignore)))
+             ;; analyze body
+             (byte-compile-lforminfo-analyze-forms lforminfo form 2
+                                                   ignore closure-flag))
+            ((eq fun 'quote)
+             ;; do nothing
+             )
+            ((eq fun 'save-window-excursion)
+             ;; `save-window-excursion' currently uses a funny implementation
+             ;; that requires its body forms be put into a closure (it should
+             ;; be fixed to work more like `save-excursion' etc., do).
+             (byte-compile-lforminfo-analyze-forms
+              lforminfo form 2
+              ignore
+              (or closure-flag
+                  (and byte-compile-save-window-excursion-uses-eval
+                       (not byte-compile-use-downward-closures)
+                       (byte-compile-lforminfo-make-closure-flag)))))
+            ((and (consp fun) (eq (car fun) 'lambda))
+             ;; Embedded lambda.  These are inlined by the compiler, so
+             ;; we don't treat them like a real closure, more like `let'.
+             ;; analyze inits
+             (byte-compile-lforminfo-analyze-forms lforminfo form 2
+                                                   ignore closure-flag)
+             
+             ;; shadow bound variables
+             (setq ignore (nconc (byte-compile-arglist-vars (cadr fun))
+                                 ignore))
+             ;; analyze body
+             (byte-compile-lforminfo-analyze-forms lforminfo fun 2
+                                                   ignore closure-flag))
+            (t
+             ;; For everything else, we just expand each argument (for
+             ;; setq/setq-default this works alright because the
+             ;; variable names are symbols).
+             (byte-compile-lforminfo-analyze-forms lforminfo form 1
+                                                   ignore closure-flag)))))))
+
+(defun byte-compile-lforminfo-analyze-forms
+  (lforminfo forms skip ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing each form in FORMS.
+The first SKIP elements of FORMS are skipped without analysis.  IGNORE
+is a list of variables that shouldn't be analyzed (usually because
+they're special, or because some inner binding shadows the version in
+LFORMINFO).  CLOSURE-FLAG should be either nil or a `closure flag' created with
+`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
+inside a lambda expression that may close over some variable in LFORMINFO."
+  (when skip
+    (setq forms (nthcdr skip forms)))
+  (while forms
+    (byte-compile-lforminfo-analyze lforminfo (pop forms)
+                                    ignore closure-flag)))
+
+(defun byte-compile-lforminfo-analyze-clauses
+  (lforminfo clauses skip ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing each clause in CLAUSES.
+Each clause is a list of forms; any clause that's not a list is ignored.  The
+first SKIP elements of each clause are skipped without analysis.  IGNORE is a
+list of variables that shouldn't be analyzed (usually because they're special,
+or because some inner binding shadows the version in LFORMINFO).
+CLOSURE-FLAG should be either nil or a `closure flag' created with
+`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
+inside a lambda expression that may close over some variable in LFORMINFO."
+  (while clauses
+    (let ((clause (pop clauses)))
+      (when (consp clause)
+        (byte-compile-lforminfo-analyze-forms lforminfo clause skip
+                                              ignore closure-flag)))))
+
+
+;;; Lexical environments
+
+;; A lexical environment is an alist, where each element is of the form
+;; (VAR . (OFFSET . ENV)) where VAR is either a symbol, for normal
+;; variables, or an `heapenv' descriptor for references to heap environment
+;; vectors.  ENV is either an atom, meaning a `stack allocated' variable
+;; (the particular atom serves to indicate the particular function context
+;; on whose stack it's allocated), or an `heapenv' descriptor (see above),
+;; meaning a variable allocated in a heap environment vector.  For the
+;; later case, an anonymous `variable' holding a pointer to the environment
+;; vector may be located by recursively looking up ENV in the environment
+;; as if it were a variable (so the entry for that `variable' will have a
+;; non-symbol VAR).
+
+;; We call a lexical environment a `lexenv', and an entry in it a `lexvar'.
+
+;; constructor
+(defsubst byte-compile-make-lexvar (name offset &optional env)
+  (cons name (cons offset env)))
+;; accessors
+(defsubst byte-compile-lexvar-name (lexvar) (car lexvar))
+(defsubst byte-compile-lexvar-offset (lexvar) (cadr lexvar))
+(defsubst byte-compile-lexvar-environment (lexvar) (cddr lexvar))
+(defsubst byte-compile-lexvar-variable-p (lexvar) (symbolp (car lexvar)))
+(defsubst byte-compile-lexvar-environment-p (lexvar)
+  (not (symbolp (car lexvar))))
+(defsubst byte-compile-lexvar-on-stack-p (lexvar)
+  (atom (byte-compile-lexvar-environment lexvar)))
+(defsubst byte-compile-lexvar-in-heap-p (lexvar)
+  (not (byte-compile-lexvar-on-stack-p lexvar)))
+
+(defun byte-compile-make-lambda-lexenv (form closed-over-lexenv)
+  "Return a new lexical environment for a lambda expression FORM.
+CLOSED-OVER-LEXENV is the lexical environment in which FORM occurs.
+The returned lexical environment contains two sets of variables:
+  * Variables that were in CLOSED-OVER-LEXENV and used by FORM
+    (all of these will be `heap' variables)
+  * Arguments to FORM (all of these will be `stack' variables)."
+  ;; See if this is a closure or not
+  (let ((closure nil)
+        (lforminfo (byte-compile-make-lforminfo))
+        (args (byte-compile-arglist-vars (cadr form))))
+    ;; Add variables from surrounding lexical environment to analysis set
+    (dolist (lexvar closed-over-lexenv)
+      (when (and (byte-compile-lexvar-in-heap-p lexvar)
+                 (not (memq (car lexvar) args)))
+        ;; The variable is located in a heap-allocated environment
+        ;; vector, so FORM may use it.  Add it to the set of variables
+        ;; that we'll search for in FORM.
+        (byte-compile-lforminfo-add-var lforminfo (car lexvar))))
+    ;; See how FORM uses these potentially closed-over variables.
+    (byte-compile-lforminfo-analyze lforminfo form args)
+    (let ((lexenv nil))
+      (dolist (vinfo (byte-compile-lforminfo-vars lforminfo))
+        (when (> (byte-compile-lvarinfo-num-refs vinfo) 0)
+          ;; FORM uses VINFO's variable, so it must be a closure.
+          (setq closure t)
+          ;; Make sure that the environment in which the variable is
+          ;; located is accessible (since we only ever pass the
+          ;; innermost environment to closures, if it's in some other
+          ;; envionment, there must be path to it from the innermost
+          ;; one).
+          (unless (byte-compile-lexvar-in-heap-p vinfo)
+            ;; To access the variable from FORM, it must be in the heap.
+            (error
+    "Compiler error: lexical variable `%s' should be heap-allocated but is not"
+             (car vinfo)))
+          (let ((closed-over-lexvar (assq (car vinfo) closed-over-lexenv)))
+            (byte-compile-heapenv-ensure-access
+             byte-compile-current-heap-environment
+             (byte-compile-lexvar-environment closed-over-lexvar))
+            ;; Put this variable in the new lexical environment
+            (push closed-over-lexvar lexenv))))
+      ;; Fill in the initial stack contents
+      (let ((stackpos 0))
+        (when closure
+          ;; Add the magic first argument that holds the environment pointer
+          (push (byte-compile-make-lexvar byte-compile-current-heap-environment
+                                          0)
+                lexenv)
+          (setq stackpos (1+ stackpos)))
+        ;; Add entries for each argument
+        (dolist (arg args)
+          (push (byte-compile-make-lexvar arg stackpos) lexenv)
+          (setq stackpos (1+ stackpos)))
+        ;; Return the new lexical environment
+        lexenv))))
+
+(defun byte-compile-closure-initial-lexenv-p (lexenv)
+  "Return non-nil if LEXENV is the initial lexical environment for a closure.
+This only works correctly when passed a new lexical environment as
+returned by `byte-compile-make-lambda-lexenv' (it works by checking to
+see whether there are any heap-allocated lexical variables in LEXENV)."
+  (let ((closure nil))
+    (while (and lexenv (not closure))
+      (when (byte-compile-lexvar-environment-p (pop lexenv))
+        (setq closure t)))
+    closure))
+
+
+;;; Heap environment vectors
+
+;; A `heap environment vector' is heap-allocated vector used to store
+;; variable that can't be put onto the stack.
+;;
+;; They are represented in the compiler by a list of the form
+;;
+;;    (SIZE SIZE-CONST-ID INIT-POSITION . ENVS)
+;;
+;; SIZE is the current size of the vector (which may be
+;; incremented if another variable or environment-reference is added to
+;; the end).  SIZE-CONST-ID is an `unknown constant id' (as returned by
+;; `byte-compile-push-unknown-constant') representing the constant used
+;; in the vector initialization code, and INIT-POSITION is a position
+;; in the byte-code output (as returned by `byte-compile-delay-out')
+;; at which more initialization code can be added.
+;; ENVS is a list of other environment vectors accessible form this one,
+;; where each element is of the form (ENV . OFFSET).
+
+;; constructor
+(defsubst byte-compile-make-heapenv (size-const-id init-position)
+  (list 0 size-const-id init-position))
+;; accessors
+(defsubst byte-compile-heapenv-size (heapenv) (car heapenv))
+(defsubst byte-compile-heapenv-size-const-id (heapenv) (cadr heapenv))
+(defsubst byte-compile-heapenv-init-position (heapenv) (nth 2 heapenv))
+(defsubst byte-compile-heapenv-accessible-envs (heapenv) (nthcdr 3 heapenv))
+
+(defun byte-compile-heapenv-add-slot (heapenv)
+  "Add a slot to the heap environment HEAPENV and return its offset."
+  (prog1 (car heapenv) (setcar heapenv (1+ (car heapenv)))))
+
+(defun byte-compile-heapenv-add-accessible-env (heapenv env offset)
+  "Add to HEAPENV's list of accessible environments, ENV at OFFSET."
+  (setcdr (nthcdr 2 heapenv)
+          (cons (cons env offset)
+                (byte-compile-heapenv-accessible-envs heapenv))))
+
+(defun byte-compile-push-heapenv ()
+  "Generate byte-code to push a new heap environment vector.
+Sets `byte-compile-current-heap-environment' to the compiler descriptor
+for the new heap environment.
+Return a `lexvar' descriptor for the new heap environment."
+  (let ((env-stack-pos byte-compile-depth)
+        size-const-id init-position)
+    ;; Generate code to push the vector
+    (byte-compile-push-constant 'make-vector)
+    (setq size-const-id (byte-compile-push-unknown-constant))
+    (byte-compile-push-constant nil)
+    (byte-compile-out 'byte-call 2)
+    (setq init-position (byte-compile-delay-out 3))
+    ;; Now make a heap-environment for the compiler to use
+    (setq byte-compile-current-heap-environment
+          (byte-compile-make-heapenv size-const-id init-position))
+    (byte-compile-make-lexvar byte-compile-current-heap-environment
+                              env-stack-pos)))
+
+(defun byte-compile-heapenv-ensure-access (heapenv other-heapenv)
+  "Make sure that HEAPENV can be used to access OTHER-HEAPENV.
+If not, then add a new slot to HEAPENV pointing to OTHER-HEAPENV."
+  (unless (memq heapenv (byte-compile-heapenv-accessible-envs heapenv))
+    (let ((offset (byte-compile-heapenv-add-slot heapenv)))
+      (byte-compile-heapenv-add-accessible-env heapenv other-heapenv offset))))
+
+
+;;; Variable binding/unbinding
+
+(defun byte-compile-non-stack-bindings-p (clauses lforminfo)
+  "Return non-nil if any lexical bindings in CLAUSES are not stack-allocated.
+LFORMINFO should be information about lexical variables being bound."
+  (let ((vars (byte-compile-lforminfo-vars lforminfo)))
+    (or (not (= (length clauses) (length vars)))
+        (progn
+          (while (and vars clauses)
+            (when (byte-compile-lvarinfo-closed-over-p (pop vars))
+              (setq clauses nil)))
+          (not clauses)))))
+
+(defun byte-compile-let-clauses-trivial-init-p (clauses)
+  "Return true if let binding CLAUSES all have a `trivial' init value.
+Trivial means either a constant value, or a simple variable initialization."
+  (or (null clauses)
+      (and (or (atom (car clauses))
+               (atom (cadr (car clauses)))
+               (eq (car (cadr (car clauses))) 'quote))
+           (byte-compile-let-clauses-trivial-init-p (cdr clauses)))))
+
+(defun byte-compile-rearrange-let-clauses (clauses lforminfo)
+  "Return CLAUSES rearranged so non-stack variables come last if possible.
+Care is taken to only do so when it's clear that the meaning is the same.
+LFORMINFO should be information about lexical variables being bound."
+  ;; We currently do a very simple job by only exchanging clauses when
+  ;; one has a constant init, or one has a variable init and the other
+  ;; doesn't have a function call init (because that could change the
+  ;; value of the variable).  This could be more clever and actually
+  ;; attempt to analyze which variables could possible be changed, etc.
+  (let ((unchanged nil)
+        (lex-non-stack nil)
+        (dynamic nil))
+    (while clauses
+      (let* ((clause (pop clauses))
+             (var (if (consp clause) (car clause) clause))
+             (init (and (consp clause) (cadr clause)))
+             (vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+        (cond
+         ((or (and vinfo
+                   (not (byte-compile-lvarinfo-closed-over-p vinfo)))
+              (not
+               (or (eq init nil) (eq init t)
+                   (and (atom init) (not (symbolp init)))
+                   (and (consp init) (eq (car init) 'quote))
+                   (byte-compile-let-clauses-trivial-init-p clauses))))
+          (push clause unchanged))
+         (vinfo
+          (push clause lex-non-stack))
+         (t
+          (push clause dynamic)))))
+    (nconc (nreverse unchanged) (nreverse lex-non-stack) (nreverse dynamic))))
+
+(defun byte-compile-maybe-push-heap-environment (&optional lforminfo)
+  "Push a new heap environment if necessary.
+LFORMINFO should be information about lexical variables being bound.
+Return a lexical environment containing only the heap vector (or
+nil if nothing was pushed).
+Also, `byte-compile-current-heap-environment' and
+`byte-compile-current-num-closures' are updated to reflect any change (so they
+should probably be bound by the caller to ensure that the new values have the
+proper scope)."
+  ;; We decide whether a new heap environment is required by seeing if
+  ;; the number of closures inside the form described by LFORMINFO is
+  ;; the same as the number inside the binding form that created the
+  ;; currently active heap environment.
+  (let ((nclosures
+         (and lforminfo (byte-compile-lforminfo-num-closures lforminfo))))
+    (if (or (null lforminfo)
+            (= nclosures byte-compile-current-num-closures))
+        ;; No need to push a heap environment.
+        nil
+      ;; Have to push one.  A heap environment is really just a vector, so
+      ;; we emit bytecodes to create a vector.  However, the size is not
+      ;; fixed yet (the vector can grow if subforms use it to store
+      ;; values, and if `access points' to parent heap environments are
+      ;; added), so we use `byte-compile-push-unknown-constant' to push the
+      ;; vector size.
+      (setq byte-compile-current-num-closures nclosures)
+      (list (byte-compile-push-heapenv)))))
+
+(defun byte-compile-bind (var init-lexenv &optional lforminfo)
+  "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
+INIT-LEXENV should be a lexical-environment alist describing the
+positions of the init value that have been pushed on the stack, and
+LFORMINFO should be information about lexical variables being bound.
+Return non-nil if the TOS value was popped."
+  ;; The presence of lexical bindings mean that we may have to
+  ;; juggle things on the stack, either to move them to TOS for
+  ;; dynamic binding, or to put them in a non-stack environment
+  ;; vector.
+  (let ((vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+    (cond ((and (null vinfo) (eq var (caar init-lexenv)))
+           ;; VAR is dynamic and is on the top of the
+           ;; stack, so we can just bind it like usual
+           (byte-compile-dynamic-variable-bind var)
+           t)
+          ((null vinfo)
+           ;; VAR is dynamic, but we have to get its
+           ;; value out of the middle of the stack
+           (let ((stack-pos (cdr (assq var init-lexenv))))
+             (byte-compile-stack-ref stack-pos)
+             (byte-compile-dynamic-variable-bind var)
+             ;; Now we have to store nil into its temporary
+             ;; stack position to avoid problems with GC
+             (byte-compile-push-constant nil)
+             (byte-compile-stack-set stack-pos))
+           nil)
+          ((byte-compile-lvarinfo-closed-over-p vinfo)
+           ;; VAR is lexical, but needs to be in a
+           ;; heap-allocated environment.
+           (unless byte-compile-current-heap-environment
+             (error "No current heap-environment to allocate `%s' in!" var))
+           (let ((init-stack-pos
+                  ;; nil if the init value is on the top of the stack,
+                  ;; otherwise the position of the init value on the stack.
+                  (and (not (eq var (caar init-lexenv)))
+                       (byte-compile-lexvar-offset (assq var init-lexenv))))
+                 (env-vec-pos
+                  ;; Position of VAR in the environment vector
+                  (byte-compile-lexvar-offset
+                   (assq var byte-compile-lexical-environment)))
+                 (env-vec-stack-pos
+                  ;; Position of the the environment vector on the stack
+                  ;; (the heap-environment must _always_ be available on
+                  ;; the stack!)
+                  (byte-compile-lexvar-offset
+                   (assq byte-compile-current-heap-environment
+                         byte-compile-lexical-environment))))
+             (unless env-vec-stack-pos
+               (error "Couldn't find location of current heap environment!"))
+             (when init-stack-pos
+               ;; VAR is not on the top of the stack, so get it
+               (byte-compile-stack-ref init-stack-pos))
+             (byte-compile-stack-ref env-vec-stack-pos)
+             ;; Store the variable into the vector
+             (byte-compile-out 'byte-vec-set env-vec-pos)
+             (when init-stack-pos
+               ;; Store nil into VAR's temporary stack
+               ;; position to avoid problems with GC
+               (byte-compile-push-constant nil)
+               (byte-compile-stack-set init-stack-pos))
+             ;; Push a record of VAR's new lexical binding
+             (push (byte-compile-make-lexvar
+                    var env-vec-pos byte-compile-current-heap-environment)
+                   byte-compile-lexical-environment)
+             (not init-stack-pos)))
+          (t
+           ;; VAR is a simple stack-allocated lexical variable
+           (push (assq var init-lexenv)
+                 byte-compile-lexical-environment)
+           nil))))
+
+(defun byte-compile-unbind (clauses init-lexenv
+                                    &optional lforminfo preserve-body-value)
+  "Emit byte-codes to unbind the variables bound by CLAUSES.
+CLAUSES is a `let'-style variable binding list.  INIT-LEXENV should be a
+lexical-environment alist describing the positions of the init value that
+have been pushed on the stack, and LFORMINFO should be information about
+the lexical variables that were bound.  If PRESERVE-BODY-VALUE is true,
+then an additional value on the top of the stack, above any lexical binding
+slots, is preserved, so it will be on the top of the stack after all
+binding slots have been popped."
+  ;; Unbind dynamic variables
+  (let ((num-dynamic-bindings 0))
+    (if lforminfo
+        (dolist (clause clauses)
+          (unless (assq (if (consp clause) (car clause) clause)
+                        (byte-compile-lforminfo-vars lforminfo))
+            (setq num-dynamic-bindings (1+ num-dynamic-bindings))))
+      (setq num-dynamic-bindings (length clauses)))
+    (unless (zerop num-dynamic-bindings)
+      (byte-compile-out 'byte-unbind num-dynamic-bindings)))
+  ;; Pop lexical variables off the stack, possibly preserving the
+  ;; return value of the body.
+  (when init-lexenv
+    ;; INIT-LEXENV contains all init values left on the stack
+    (byte-compile-discard (length init-lexenv) preserve-body-value)))
+
+
+(provide 'byte-lexbind)
+
+;;; arch-tag: b8f1dff6-9edb-4430-a96f-323d42a681a9
+;;; byte-lexbind.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e461010a6ce..4c0094dd78b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -186,8 +186,8 @@
 (eval-when-compile (require 'cl))
 
 (defun byte-compile-log-lap-1 (format &rest args)
-  (if (aref byte-code-vector 0)
-      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
+;;   (if (aref byte-code-vector 0)
+;;       (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
   (byte-compile-log-1
    (apply 'format format
      (let (c a)
@@ -281,7 +281,8 @@
                        (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
                     (cdr form)))
           (if (eq (car-safe fn) 'lambda)
-              (cons fn (cdr form))
+              (macroexpand-all (cons fn (cdr form))
+                               byte-compile-macro-environment)
             ;; Give up on inlining.
             form))))))
 
@@ -1332,14 +1333,15 @@
         ((>= op byte-constant)
          (prog1 (- op byte-constant)    ;offset in opcode
            (setq op byte-constant)))
-        ((and (>= op byte-constant2)
-              (<= op byte-goto-if-not-nil-else-pop))
+        ((or (and (>= op byte-constant2)
+                  (<= op byte-goto-if-not-nil-else-pop))
+             (= op byte-stack-set2))
          (setq ptr (1+ ptr))            ;offset in next 2 bytes
          (+ (aref bytes ptr)
             (progn (setq ptr (1+ ptr))
                    (lsh (aref bytes ptr) 8))))
         ((and (>= op byte-listN)
-              (<= op byte-insertN))
+              (<= op byte-discardN))
          (setq ptr (1+ ptr))            ;offset in next byte
          (aref bytes ptr))))
 
@@ -1400,7 +1402,16 @@
              (if (= ptr (1- length))
                  (setq op nil)
                (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
-                     op 'byte-goto))))
+                     op 'byte-goto)))
+            ((eq op 'byte-stack-set2)
+             (setq op 'byte-stack-set))
+            ((and (eq op 'byte-discardN) (>= offset #x80))
+             ;; The top bit of the operand for byte-discardN is a flag,
+             ;; saying whether the top-of-stack is preserved.  In
+             ;; lapcode, we represent this by using a different opcode
+             ;; (with the flag removed from the operand).
+             (setq op 'byte-discardN-preserve-tos)
+             (setq offset (- offset #x80))))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (setq lap (cons (cons optr (cons op (or offset 0)))
                       lap))
@@ -1456,7 +1467,7 @@
     byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
     byte-point-min byte-following-char byte-preceding-char
     byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
-    byte-current-buffer byte-interactive-p))
+    byte-current-buffer byte-interactive-p byte-stack-ref))
 
 (defconst byte-compile-side-effect-free-ops
   (nconc
@@ -1465,7 +1476,7 @@
      byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
      byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
      byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
-     byte-member byte-assq byte-quo byte-rem)
+     byte-member byte-assq byte-quo byte-rem byte-vec-ref)
    byte-compile-side-effect-and-error-free-ops))
 
 ;; This crock is because of the way DEFVAR_BOOL variables work.
@@ -1498,12 +1509,50 @@
 ;; The variable `byte-boolean-vars' is now primitive and updated
 ;; automatically by DEFVAR_BOOL.
 
+(defmacro byte-opt-update-stack-params (stack-adjust stack-depth lap0 rest lap)
+  "...macro used by byte-optimize-lapcode..."
+  `(progn
+     (byte-compile-log-lap "Before %s  [depth = %s]" ,lap0 ,stack-depth)
+     (cond ((eq (car ,lap0) 'TAG)
+            ;; A tag can encode the expected stack depth.
+            (when (cddr ,lap0)
+              ;; First, check to see if our notion of the current stack
+              ;; depth agrees with this tag.  We don't check at the
+              ;; beginning of the function, because the presence of
+              ;; lexical arguments means the first tag will have a
+              ;; non-zero offset.
+              (when (and (not (eq ,rest ,lap)) ; not at first insn
+                         ,stack-depth   ; not just after a goto
+                         (not (= (cddr ,lap0) ,stack-depth)))
+                (error "Compiler error: optimizer is confused about %s:
+  %s != %s at lapcode %s" ',stack-depth (cddr ,lap0) ,stack-depth ,lap0))
+              ;; Now set out current depth from this tag
+              (setq ,stack-depth (cddr ,lap0)))
+            (setq ,stack-adjust 0))
+           ((memq (car ,lap0) '(byte-goto byte-return))
+            ;; These insns leave us in an unknown state
+            (setq ,stack-adjust nil))
+           ((car ,lap0)
+            ;; Not a no-op, set ,stack-adjust for lap0.  ,stack-adjust will
+            ;; be added to ,stack-depth at the end of the loop, so any code
+            ;; that modifies the instruction sequence must adjust this too.
+            (setq ,stack-adjust
+                  (byte-compile-stack-adjustment (car ,lap0) (cdr ,lap0)))))
+     (byte-compile-log-lap "Before %s  [depth => %s, adj = %s]" ,lap0 ,stack-depth ,stack-adjust)
+     ))
+
 (defun byte-optimize-lapcode (lap &optional for-effect)
   "Simple peephole optimizer.  LAP is both modified and returned.
 If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
   (let (lap0
         lap1
         lap2
+        stack-adjust
+        stack-depth
+        (initial-stack-depth
+         (if (and lap (eq (car (car lap)) 'TAG))
+             (cdr (cdr (car lap)))
+           0))
         (keep-going 'first-time)
         (add-depth 0)
         rest tmp tmp2 tmp3
@@ -1514,12 +1563,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
       (or (eq keep-going 'first-time)
           (byte-compile-log-lap "  ---- next pass"))
       (setq rest lap
+            stack-depth initial-stack-depth
             keep-going nil)
       (while rest
         (setq lap0 (car rest)
               lap1 (nth 1 rest)
               lap2 (nth 2 rest))
 
+        (byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap)
+
         ;; 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.
@@ -1533,22 +1585,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
               ((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)
+               (cond ((= stack-adjust 1)
                       (byte-compile-log-lap
                        "  %s discard\t-->\t<deleted>" lap0)
                       (setq lap (delq lap0 (delq lap1 lap))))
-                     ((= tmp 0)
+                     ((= stack-adjust 0)
                       (byte-compile-log-lap
                        "  %s discard\t-->\t<deleted> discard" lap0)
                       (setq lap (delq lap0 lap)))
-                     ((= tmp -1)
+                     ((= stack-adjust -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"))))
+                     ((error "Optimizer error: too much on the stack")))
+               (setq stack-adjust (1- stack-adjust)))
               ;;
               ;; goto*-X X:  -->  X:
               ;;
@@ -1573,10 +1625,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
               ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
               ;; The latter two can enable other optimizations.
               ;;
-              ((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))
+              ((or (and (eq 'byte-varref (car lap2))
+                        (eq (cdr lap1) (cdr lap2))
+                        (memq (car lap1) '(byte-varset byte-varbind)))
+                   (and (eq (car lap2) 'byte-stack-ref)
+                        (eq (car lap1) 'byte-stack-set)
+                        (eq (cdr lap1) (cdr lap2))))
+               (if (and (eq 'byte-varref (car lap2))
+                        (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
                         (not (eq (car lap0) 'byte-constant)))
                    nil
                  (setq keep-going t)
@@ -1608,10 +1664,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
               ;;
               ((and (eq 'byte-dup (car lap0))
                     (eq 'byte-discard (car lap2))
-                    (memq (car lap1) '(byte-varset byte-varbind)))
+                    (memq (car lap1) '(byte-varset byte-varbind byte-stack-set byte-vec-set)))
                (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
                (setq keep-going t
-                     rest (cdr rest))
+                     rest (cdr rest)
+                     stack-adjust -1)
                (setq lap (delq lap0 (delq lap2 lap))))
               ;;
               ;; not goto-X-if-nil              -->  goto-X-if-non-nil
@@ -1633,7 +1690,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                                 'byte-goto-if-not-nil
                                 'byte-goto-if-nil))
                (setq lap (delq lap0 lap))
-               (setq keep-going t))
+               (setq keep-going t
+                     stack-adjust 0))
               ;;
               ;; 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:
@@ -1649,7 +1707,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                  (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
                                        lap0 lap1 lap2
                                        (cons inverse (cdr lap1)) lap2)
-                 (setq lap (delq lap0 lap))
+                 (setq lap (delq lap0 lap)
+                       stack-adjust 0)
                  (setcar lap1 inverse)
                  (setq keep-going t)))
               ;;
@@ -1666,15 +1725,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                       (setq rest (cdr rest)
                             lap (delq lap0 (delq lap1 lap))))
                      (t
-                      (if (memq (car lap1) byte-goto-always-pop-ops)
-                          (progn
-                            (byte-compile-log-lap "  %s %s\t-->\t%s"
-                             lap0 lap1 (cons 'byte-goto (cdr lap1)))
-                            (setq lap (delq lap0 lap)))
-                        (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-                         (cons 'byte-goto (cdr lap1))))
+                      (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))
+               (setq keep-going t
+                     stack-adjust 0))
               ;;
               ;; varref-X varref-X  -->  varref-X dup
               ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
@@ -1682,14 +1740,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
               ;; because that would inhibit some goto optimizations; we
               ;; optimize the const-X case after all other optimizations.
               ;;
-              ((and (eq 'byte-varref (car lap0))
+              ((and (memq (car lap0) '(byte-varref byte-stack-ref))
                     (progn
-                      (setq tmp (cdr rest))
+                      (setq tmp (cdr rest) tmp2 0)
                       (while (eq (car (car tmp)) 'byte-dup)
-                        (setq tmp (cdr tmp)))
+                        (setq tmp (cdr tmp) tmp2 (1+ tmp2)))
                       t)
-                    (eq (cdr lap0) (cdr (car tmp)))
-                    (eq 'byte-varref (car (car tmp))))
+                    (eq (car lap0) (car (car tmp)))
+                    (eq (cdr lap0) (cdr (car tmp))))
                (if (memq byte-optimize-log '(t byte))
                    (let ((str ""))
                      (setq tmp2 (cdr rest))
@@ -1701,7 +1759,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                (setq keep-going t)
                (setcar (car tmp) 'byte-dup)
                (setcdr (car tmp) 0)
-               (setq rest tmp))
+               (setq rest tmp
+                     stack-adjust (+ 2 tmp2)))
               ;;
               ;; TAG1: TAG2: --> TAG1: <deleted>
               ;; (and other references to TAG2 are replaced with TAG1)
@@ -1768,7 +1827,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                (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))
+               (setq keep-going t
+                     stack-adjust 0))
               ;;
               ;; varbind-X unbind-N         -->  discard unbind-(N-1)
               ;; save-excursion unbind-N    -->  unbind-(N-1)
@@ -1794,6 +1854,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                    ""))
                (setq keep-going t))
               ;;
+              ;; stack-ref-N  -->  dup    ; where N is TOS
+              ;;
+              ((and (eq (car lap0) 'byte-stack-ref)
+                    (= (cdr lap0) (1- stack-depth)))
+               (setcar lap0 'byte-dup)
+               (setcdr lap0 nil)
+               (setq keep-going t))
+              ;;
               ;; goto*-X ... X: goto-Y  --> goto*-Y
               ;; goto-X ...  X: return  --> return
               ;;
@@ -1870,20 +1938,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                                             (cdr tmp))))
                       (setcdr lap1 (car (cdr tmp)))
                       (setq lap (delq lap0 lap))))
-               (setq keep-going t))
+               (setq keep-going t
+                     stack-adjust 0))
               ;;
               ;; 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).
               ;;
-              ((and (eq (car lap1) 'byte-varset)
+              ((and (memq (car lap1) '(byte-varset byte-stack-set))
                     (eq (car lap2) 'byte-goto)
                     (not (memq (cdr lap2) rest)) ;Backwards jump
                     (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
-                        'byte-varref)
+                        (if (eq (car lap1) 'byte-varset) 'byte-varref 'byte-stack-ref))
                     (eq (cdr (car tmp)) (cdr lap1))
-                    (not (memq (car (cdr lap1)) byte-boolean-vars)))
+                    (not (and (eq (car lap1) 'byte-varref)
+                              (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
@@ -1940,10 +2010,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
                                            byte-goto-if-not-nil
                                            byte-goto byte-goto))))
                )
-               (setq keep-going t))
+               (setq keep-going t
+                     stack-adjust (and (not (eq (car lap0) 'byte-goto)) -1)))
               )
+
+        (setq stack-depth 
+              (and stack-depth stack-adjust (+ stack-depth stack-adjust)))
         (setq rest (cdr rest)))
       )
+
     ;; Cleanup stage:
     ;; Rebuild byte-compile-constants / byte-compile-variables.
     ;; Simple optimizations that would inhibit other optimizations if they
@@ -1951,10 +2026,13 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
     ;;  need to do more than once.
     (setq byte-compile-constants nil
           byte-compile-variables nil)
-    (setq rest lap)
+    (setq rest lap
+          stack-depth initial-stack-depth)
+    (byte-compile-log-lap "  ---- final pass")
     (while rest
       (setq lap0 (car rest)
             lap1 (nth 1 rest))
+      (byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap)
       (if (memq (car lap0) byte-constref-ops)
           (if (or (eq (car lap0) 'byte-constant)
                   (eq (car lap0) 'byte-constant2))
@@ -2001,11 +2079,108 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
              (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
                                    (cons 'byte-unbind
                                          (+ (cdr lap0) (cdr lap1))))
-             (setq keep-going t)
              (setq lap (delq lap0 lap))
              (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 (- stack-depth 2 (cdr lap0)))
+                    (setq tmp3 0)
+                    (while (memq (car (car tmp)) '(byte-discard byte-discardN))
+                      (if (eq (car (car tmp)) 'byte-discard)
+                          (setq tmp3 (1+ tmp3))
+                        (setq tmp3 (+ tmp3 (cdr (car tmp)))))
+                      (setq tmp (cdr tmp)))
+                    (>= tmp3 tmp2)))
+             ;; Do the optimization
+             (setq lap (delq lap0 lap))
+             (cond ((= 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.
+                    (setcar lap1 'byte-discardN-preserve-tos)
+                    (setcdr lap1 (1+ tmp3)))
+                   (t
+                    ;; Otherwise, the value stored is lost, so just use a
+                    ;; normal discard.
+                    (setcar lap1 'byte-discardN)
+                    (setcdr lap1 tmp3)))
+             (setcdr (cdr rest) tmp)
+             (setq stack-adjust 0)
+             (byte-compile-log-lap "  %s [discard/discardN]...\t-->\t%s"
+                                   lap0 lap1))
+
+            ;;
+            ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y  -->
+            ;; discardN-(X+Y)
+            ;;
+            ((and (memq (car lap0)
+                        '(byte-discard
+                          byte-discardN
+                          byte-discardN-preserve-tos))
+                  (memq (car lap1) '(byte-discard byte-discardN)))
+             (setq lap (delq lap0 lap))
+             (byte-compile-log-lap
+              "  %s %s\t-->\t(discardN %s)"
+              lap0 lap1
+              (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
+                 (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
+             (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
+                             (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
+             (setcar lap1 'byte-discardN)
+             (setq stack-adjust 0))
+
+            ;;
+            ;; discardN-preserve-tos-X discardN-preserve-tos-Y  -->
+            ;; discardN-preserve-tos-(X+Y)
+            ;;
+            ((and (eq (car lap0) 'byte-discardN-preserve-tos)
+                  (eq (car lap1) 'byte-discardN-preserve-tos))
+             (setq lap (delq lap0 lap))
+             (setcdr lap1 (+ (cdr lap0) (cdr lap1)))
+             (setq stack-adjust 0)
+             (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) (- stack-depth 2)))))
+             ;; the byte-code interpreter will pop the stack for us, so
+             ;; we can just leave stuff on it
+             (setq lap (delq lap0 lap))
+             (setq stack-adjust 0)
+             (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 lap1))
+
+            ;;
+            ;; dup stack-set-N return  -->  return     ; where N is TOS
+            ;;
+            ((and (eq (car lap0) 'byte-dup)
+                  (eq (car lap1) 'byte-stack-set)
+                  (eq (car (car (cdr (cdr rest)))) 'byte-return)
+                  (= (cdr lap1) (1- stack-depth)))
+             (setq lap (delq lap0 (delq lap1 lap)))
+             (setq rest (cdr rest))
+             (setq stack-adjust 0)
+             (byte-compile-log-lap "  dup %s return\t-->\treturn" lap1))
             )
+
+      (setq stack-depth 
+            (and stack-depth stack-adjust (+ stack-depth stack-adjust)))
       (setq rest (cdr rest)))
+
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 217afea9f8a..c80bcd49b82 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -116,12 +116,55 @@
 ;;     Some versions of `file' can be customized to recognize that.
 
 (require 'backquote)
+(require 'macroexp)
 (eval-when-compile (require 'cl))
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
     (load "byte-run"))
 
+;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation
+;; errors; however that file also wants to do (require 'bytecomp) for the
+;; same reason.  Since we know it's OK to load byte-lexbind.el second, we
+;; have that file require a feature that's provided before at the beginning
+;; of this file, to avoid an infinite require loop.
+;; `eval-when-compile' is defined in byte-run.el, so it must come after the
+;; preceding load expression.
+(provide 'bytecomp-preload)
+(eval-when-compile (require 'byte-lexbind))
+
+;; The feature of compiling in a specific target Emacs version
+;; has been turned off because compile time options are a bad idea.
+(defmacro byte-compile-single-version () nil)
+(defmacro byte-compile-version-cond (cond) cond)
+
+;; The crud you see scattered through this file of the form
+;;   (or (and (boundp 'epoch::version) epoch::version)
+;;        (string-lessp emacs-version "19"))
+;; is because the Epoch folks couldn't be bothered to follow the
+;; normal emacs version numbering convention.
+
+;; (if (byte-compile-version-cond
+;;      (or (and (boundp 'epoch::version) epoch::version)
+;;       (string-lessp emacs-version "19")))
+;;     (progn
+;;       ;; emacs-18 compatibility.
+;;       (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
+;;
+;;       (if (byte-compile-single-version)
+;;        (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
+;;      (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
+;;
+;;       (or (and (fboundp 'member)
+;;             ;; avoid using someone else's possibly bogus definition of this.
+;;             (subrp (symbol-function 'member)))
+;;        (defun member (elt list)
+;;          "like memq, but uses equal instead of eq.  In v19, this is a subr."
+;;          (while (and list (not (equal elt (car list))))
+;;            (setq list (cdr list)))
+;;          list))))
+
+
 (defgroup bytecomp nil
   "Emacs Lisp byte-compiler."
   :group 'lisp)
@@ -398,7 +441,17 @@ specify different fields to sort on."
   :type '(choice (const name) (const callers) (const calls)
                  (const calls+callers) (const nil)))
 
-(defvar byte-compile-debug nil)
+;(defvar byte-compile-debug nil)
+(defvar byte-compile-debug t)
+
+;; (defvar byte-compile-overwrite-file t
+;;   "If nil, old .elc files are deleted before the new is saved, and .elc
+;; files will have the same modes as the corresponding .el file.  Otherwise,
+;; existing .elc files will simply be overwritten, and the existing modes
+;; will not be changed.  If this variable is nil, then an .elc file which
+;; is a symbolic link will be turned into a normal file, instead of the file
+;; which the link points to being overwritten.")
+
 (defvar byte-compile-constants nil
   "List of all constants encountered during compilation of this form.")
 (defvar byte-compile-variables nil
@@ -418,11 +471,18 @@ This list lives partly on the stack.")
 ;;     (byte-compiler-options . (lambda (&rest forms)
 ;;                             (apply 'byte-compiler-options-handler forms)))
     (eval-when-compile . (lambda (&rest body)
-                           (list 'quote
-                                 (byte-compile-eval (byte-compile-top-level
-                                                     (cons 'progn body))))))
+                           (list
+                            'quote
+                            (byte-compile-eval
+                              (byte-compile-top-level
+                               (macroexpand-all
+                                (cons 'progn body)
+                                byte-compile-initial-macro-environment))))))
     (eval-and-compile . (lambda (&rest body)
-                          (byte-compile-eval-before-compile (cons 'progn body))
+                          (byte-compile-eval-before-compile
+                           (macroexpand-all
+                            (cons 'progn body)
+                            byte-compile-initial-macro-environment))
                           (cons 'progn body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
@@ -453,6 +513,14 @@ defined with incorrect args.")
 Used for warnings about calling a function that is defined during compilation
 but won't necessarily be defined when the compiled file is loaded.")
 
+;; Variables for lexical binding
+(defvar byte-compile-lexical-environment nil
+  "The current lexical environment.")
+(defvar byte-compile-current-heap-environment nil
+  "If non-nil, a descriptor for the current heap-allocated lexical environment.")
+(defvar byte-compile-current-num-closures 0
+  "The number of lexical closures that close over `byte-compile-current-heap-environment'.")
+
 (defvar byte-compile-tag-number 0)
 (defvar byte-compile-output nil
   "Alist describing contents to put in byte code string.
@@ -498,11 +566,10 @@ Each element is (INDEX . VALUE)")
     (put 'byte-stack+-info 'tmp-compile-time-value nil)))
 
 
-;; unused: 0-7
-
 ;; These opcodes are special in that they pack their argument into the
 ;; opcode word.
 ;;
+(byte-defop   0  1 byte-stack-ref "for stack reference")
 (byte-defop   8  1 byte-varref  "for variable reference")
 (byte-defop  16 -1 byte-varset  "for setting a variable")
 (byte-defop  24 -1 byte-varbind "for binding a variable")
@@ -664,11 +731,28 @@ otherwise pop it")
 (byte-defop 168  0 byte-integerp)
 
 ;; unused: 169-174
+
 (byte-defop 175 nil byte-listN)
 (byte-defop 176 nil byte-concatN)
 (byte-defop 177 nil byte-insertN)
 
-;; unused: 178-191
+(byte-defop 178 -1 byte-stack-set)      ; stack offset in following one byte
+(byte-defop 179 -1 byte-stack-set2)     ; stack offset in following two bytes
+(byte-defop 180  1 byte-vec-ref)        ; vector offset in following one byte
+(byte-defop 181 -1 byte-vec-set)        ; vector offset in following one byte
+
+;; if (following one byte & 0x80) == 0
+;;    discard (following one byte & 0x7F) stack entries
+;; else
+;;    discard (following one byte & 0x7F) stack entries _underneath_ the top of stack
+;;    (that is, if the operand = 0x83,  ... X Y Z T  =>  ... T)
+(byte-defop 182 nil byte-discardN)
+;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into
+;; `byte-discardN' with the high bit in the operand set (by
+;; `byte-compile-lapcode').
+(defconst byte-discardN-preserve-tos byte-discardN)
+
+;; unused: 182-191
 
 (byte-defop 192  1 byte-constant        "for reference to a constant")
 ;; codes 193-255 are consumed by byte-constant.
@@ -715,71 +799,108 @@ otherwise pop it")
 ;; front of the constants-vector than the constant-referencing instructions.
 ;; Also, this lets us notice references to free variables.
 
+(defmacro byte-compile-push-bytecodes (&rest args)
+  "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
+ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
+BYTES and PC are updated after evaluating all the arguments."
+  (let ((byte-exprs (butlast args 2))
+        (bytes-var (car (last args 2)))
+        (pc-var (car (last args))))
+    `(setq ,bytes-var ,(if (null (cdr byte-exprs))
+                           `(cons ,@byte-exprs ,bytes-var)
+                         `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
+           ,pc-var (+ ,(length byte-exprs) ,pc-var))))
+
+(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
+  "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
+CONST2 may be evaulated multiple times."
+  `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8)
+                                ,bytes ,pc))
+
 (defun byte-compile-lapcode (lap)
   "Turns lapcode into bytecode.  The lapcode is destroyed."
   ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
   (let ((pc 0)                  ; Program counter
         op off                  ; Operation & offset
+        opcode                  ; numeric value of OP
         (bytes '())             ; Put the output bytes here
-        (patchlist nil))        ; List of tags and goto's to patch
-    (while lap
-      (setq op (car (car lap))
-            off (cdr (car lap)))
+        (patchlist nil))        ; List of gotos to patch
+    (dolist (lap-entry lap)
+      (setq op (car lap-entry)
+            off (cdr lap-entry))
       (cond ((not (symbolp op))
              (error "Non-symbolic opcode `%s'" op))
             ((eq op 'TAG)
-             (setcar off pc)
-             (setq patchlist (cons off patchlist)))
-            ((memq op byte-goto-ops)
-             (setq pc (+ pc 3))
-             (setq bytes (cons (cons pc (cdr off))
-                               (cons nil
-                                     (cons (symbol-value op) bytes))))
-             (setq patchlist (cons bytes patchlist)))
+             (setcar off pc))
+            ((null op)
+             ;; a no-op added by `byte-compile-delay-out'
+             (unless (zerop off)
+               (error
+                "Placeholder added by `byte-compile-delay-out' not filled in.")
+               ))
             (t
-             (setq bytes
-                   (cond ((cond ((consp off)
-                                 ;; Variable or constant reference
-                                 (setq off (cdr off))
-                                 (eq op 'byte-constant)))
-                          (cond ((< off byte-constant-limit)
-                                 (setq pc (1+ pc))
-                                 (cons (+ byte-constant off) bytes))
-                                (t
-                                 (setq pc (+ 3 pc))
-                                 (cons (lsh off -8)
-                                       (cons (logand off 255)
-                                             (cons byte-constant2 bytes))))))
-                         ((<= byte-listN (symbol-value op))
-                          (setq pc (+ 2 pc))
-                          (cons off (cons (symbol-value op) bytes)))
-                         ((< off 6)
-                          (setq pc (1+ pc))
-                          (cons (+ (symbol-value op) off) bytes))
-                         ((< off 256)
-                          (setq pc (+ 2 pc))
-                          (cons off (cons (+ (symbol-value op) 6) bytes)))
-                         (t
-                          (setq pc (+ 3 pc))
-                          (cons (lsh off -8)
-                                (cons (logand off 255)
-                                      (cons (+ (symbol-value op) 7)
-                                            bytes))))))))
-      (setq lap (cdr lap)))
+             (if (eq op 'byte-discardN-preserve-tos)
+                 ;; byte-discardN-preserve-tos is a psuedo op, which is actually
+                 ;; the same as byte-discardN with a modified argument
+                 (setq opcode byte-discardN)
+               (setq opcode (symbol-value op)))
+             (cond ((memq op byte-goto-ops)
+                    ;; goto
+                    (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
+                    (push bytes patchlist)) 
+                   ((and (consp off)
+                         ;; Variable or constant reference
+                         (progn (setq off (cdr off))
+                                (eq op 'byte-constant)))
+                    ;; constant ref
+                    (if (< off byte-constant-limit)
+                        (byte-compile-push-bytecodes (+ byte-constant off)
+                                                     bytes pc)
+                      (byte-compile-push-bytecode-const2 byte-constant2 off
+                                                         bytes pc)))
+                   ((and (= opcode byte-stack-set)
+                         (> off 255))
+                    ;; Use the two-byte version of byte-stack-set if the
+                    ;; offset is too large for the normal version.
+                    (byte-compile-push-bytecode-const2 byte-stack-set2 off
+                                                       bytes pc))
+                   ((and (>= opcode byte-listN)
+                         (< opcode byte-discardN))
+                    ;; These insns all put their operand into one extra byte.
+                    (byte-compile-push-bytecodes opcode off bytes pc))
+                   ((= opcode byte-discardN)
+                    ;; byte-discardN is wierd in that it encodes a flag in the
+                    ;; top bit of its one-byte argument.  If the argument is
+                    ;; too large to fit in 7 bits, the opcode can be repeated.
+                    (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
+                      (while (> off #x7f)
+                        (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc)
+                        (setq off (- off #x7f)))
+                      (byte-compile-push-bytecodes opcode (logior off flag) bytes pc)))
+                   ((null off)
+                    ;; opcode that doesn't use OFF
+                    (byte-compile-push-bytecodes opcode bytes pc))
+                   ;; The following three cases are for the special
+                   ;; insns that encode their operand into 0, 1, or 2
+                   ;; extra bytes depending on its magnitude.
+                   ((< off 6)
+                    (byte-compile-push-bytecodes (+ opcode off) bytes pc))
+                   ((< off 256)
+                    (byte-compile-push-bytecodes (+ opcode 6) off bytes pc))
+                   (t
+                    (byte-compile-push-bytecode-const2 (+ opcode 7) off
+                                                       bytes pc))))))
     ;;(if (not (= pc (length bytes)))
     ;;    (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
-    ;; Patch PC into jumps
-    (let (bytes)
-      (while patchlist
-        (setq bytes (car patchlist))
-        (cond ((atom (car bytes)))      ; Tag
-              (t                        ; Absolute jump
-               (setq pc (car (cdr (car bytes))))        ; Pick PC from tag
-               (setcar (cdr bytes) (logand pc 255))
-               (setcar bytes (lsh pc -8))
-               ;; FIXME: Replace this by some workaround.
-               (if (> (car bytes) 255) (error "Bytecode overflow"))))
-        (setq patchlist (cdr patchlist))))
+
+    ;; Patch tag PCs into absolute jumps
+    (dolist (bytes-tail patchlist)
+      (setq pc (caar bytes-tail))       ; Pick PC from goto's tag
+      (setcar (cdr bytes-tail) (logand pc 255))
+      (setcar bytes-tail (lsh pc -8))
+      ;; FIXME: Replace this by some workaround.
+      (if (> (car bytes) 255) (error "Bytecode overflow")))
+
     (apply 'unibyte-string (nreverse bytes))))
 
 
@@ -2073,18 +2194,16 @@ list that represents a doc string reference.
 (defun byte-compile-file-form (form)
   (let ((byte-compile-current-form nil) ; close over this for warnings.
         bytecomp-handler)
-    (cond
-     ((not (consp form))
-      (byte-compile-keep-pending form))
-     ((and (symbolp (car form))
-           (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
-      (cond ((setq form (funcall bytecomp-handler form))
-             (byte-compile-flush-pending)
-             (byte-compile-output-file-form form))))
-     ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
-      (byte-compile-keep-pending form))
-     (t
-      (byte-compile-file-form form)))))
+    (setq form (macroexpand-all form byte-compile-macro-environment))
+    (cond ((not (consp form))
+           (byte-compile-keep-pending form))
+          ((and (symbolp (car form))
+                (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
+           (cond ((setq form (funcall bytecomp-handler form))
+                  (byte-compile-flush-pending)
+                  (byte-compile-output-file-form form))))
+          (t
+           (byte-compile-keep-pending form)))))
 
 ;; Functions and variables with doc strings must be output separately,
 ;; so make-docfile can recognise them.  Most other things can be output
@@ -2096,8 +2215,7 @@ list that represents a doc string reference.
     (setq byte-compile-current-form (nth 1 form))
     (byte-compile-warn "defsubst `%s' was used before it was defined"
                        (nth 1 form)))
-  (byte-compile-file-form
-   (macroexpand form byte-compile-macro-environment))
+  (byte-compile-file-form form)
   ;; Return nil so the form is not output twice.
   nil)
 
@@ -2418,6 +2536,12 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (if macro
           (setq fun (cdr fun)))
       (cond ((eq (car-safe fun) 'lambda)
+             ;; expand macros
+             (setq fun
+                   (macroexpand-all fun
+                                    byte-compile-initial-macro-environment))
+             ;; get rid of the `function' quote added by the `lambda' macro
+             (setq fun (cadr fun))
              (setq fun (if macro
                            (cons 'macro (byte-compile-lambda fun))
                          (byte-compile-lambda fun)))
@@ -2505,6 +2629,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (setq list (cdr list)))))
 
 
+(autoload 'byte-compile-make-lambda-lexenv "byte-lexbind")
+
 ;; Byte-compile a lambda-expression and return a valid function.
 ;; The value is usually a compiled function but may be the original
 ;; lambda-expression.
@@ -2561,20 +2687,43 @@ If FORM is a lambda or a macro, byte-compile it as a function."
              (byte-compile-warn "malformed interactive spec: %s"
                                 (prin1-to-string bytecomp-int)))))
     ;; Process the body.
-    (let ((compiled (byte-compile-top-level
-                     (cons 'progn bytecomp-body) nil 'lambda)))
+    (let* ((byte-compile-lexical-environment
+            ;; If doing lexical binding, push a new lexical environment
+            ;; containing the args and any closed-over variables.
+            (and lexical-binding
+                 (byte-compile-make-lambda-lexenv
+                  fun
+                  byte-compile-lexical-environment))) 
+           (is-closure
+            ;; This is true if we should be making a closure instead of
+            ;; a simple lambda (because some variables from the
+            ;; containing lexical environment are closed over).
+            (and lexical-binding
+                 (byte-compile-closure-initial-lexenv-p
+                  byte-compile-lexical-environment)))
+           (byte-compile-current-heap-environment nil)
+           (byte-compile-current-num-closures 0)
+           (compiled
+            (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
       ;; Build the actual byte-coded function.
       (if (eq 'byte-code (car-safe compiled))
-          (apply 'make-byte-code
-                 (append (list bytecomp-arglist)
-                         ;; byte-string, constants-vector, stack depth
-                         (cdr compiled)
-                         ;; optionally, the doc string.
-                         (if (or bytecomp-doc bytecomp-int)
-                             (list bytecomp-doc))
-                         ;; optionally, the interactive spec.
-                         (if bytecomp-int
-                             (list (nth 1 bytecomp-int)))))
+          (let ((code
+                 (apply 'make-byte-code
+                        (append (list bytecomp-arglist)
+                                ;; byte-string, constants-vector, stack depth
+                                (cdr compiled)
+                                ;; optionally, the doc string.
+                                (if (or bytecomp-doc bytecomp-int
+                                        lexical-binding)
+                                    (list bytecomp-doc))
+                                ;; optionally, the interactive spec.
+                                (if (or bytecomp-int lexical-binding)
+                                    (list (nth 1 bytecomp-int)))
+                                (if lexical-binding
+                                    '(t))))))
+            (if is-closure
+                (cons 'closure code)
+              code))
         (setq compiled
               (nconc (if bytecomp-int (list bytecomp-int))
                      (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
@@ -2585,6 +2734,26 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                                    (bytecomp-body (list nil))))
                  compiled))))))
 
+(defun byte-compile-closure-code-p (code)
+  (eq (car-safe code) 'closure))
+
+(defun byte-compile-make-closure (code)
+  ;; A real closure requires that the constant be curried with an
+  ;; environment vector to make a closure object.
+  (if for-effect
+      (setq for-effect nil)
+    (byte-compile-push-constant 'curry)
+    (byte-compile-push-constant code)
+    (byte-compile-lexical-variable-ref byte-compile-current-heap-environment)
+    (byte-compile-out 'byte-call 2)))
+
+(defun byte-compile-closure (form &optional add-lambda)
+  (let ((code (byte-compile-lambda form add-lambda)))
+    (if (byte-compile-closure-code-p code)
+        (byte-compile-make-closure code)
+      ;; A simple lambda is just a constant
+      (byte-compile-constant code))))
+
 (defun byte-compile-constants-vector ()
   ;; Builds the constants-vector from the current variables and constants.
   ;;   This modifies the constants from (const . nil) to (const . offset).
@@ -2629,17 +2798,51 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         (byte-compile-depth 0)
         (byte-compile-maxdepth 0)
         (byte-compile-output nil))
-     (if (memq byte-optimize '(t source))
-         (setq form (byte-optimize-form form for-effect)))
-     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
-       (setq form (nth 1 form)))
-     (if (and (eq 'byte-code (car-safe form))
-              (not (memq byte-optimize '(t byte)))
-              (stringp (nth 1 form)) (vectorp (nth 2 form))
-              (natnump (nth 3 form)))
-         form
-       (byte-compile-form form for-effect)
-       (byte-compile-out-toplevel for-effect output-type))))
+    (if (memq byte-optimize '(t source))
+        (setq form (byte-optimize-form form for-effect)))
+    (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
+      (setq form (nth 1 form)))
+    (if (and (eq 'byte-code (car-safe form))
+             (not (memq byte-optimize '(t byte)))
+             (stringp (nth 1 form)) (vectorp (nth 2 form))
+             (natnump (nth 3 form)))
+        form
+      ;; Set up things for a lexically-bound function
+      (when (and lexical-binding (eq output-type 'lambda))
+        ;; See how many arguments there are, and set the current stack depth
+        ;; accordingly
+        (dolist (var byte-compile-lexical-environment)
+          (when (byte-compile-lexvar-on-stack-p var)
+            (setq byte-compile-depth (1+ byte-compile-depth))))
+        ;; If there are args, output a tag to record the initial
+        ;; stack-depth for the optimizer
+        (when (> byte-compile-depth 0)
+          (byte-compile-out-tag (byte-compile-make-tag)))
+        ;; If this is the top-level of a lexically bound lambda expression,
+        ;; perhaps some parameters on stack need to be copied into a heap
+        ;; environment, so check for them, and do so if necessary.
+        (let ((lforminfo (byte-compile-make-lforminfo)))
+          ;; Add any lexical variable that's on the stack to the analysis set.
+          (dolist (var byte-compile-lexical-environment)
+            (when (byte-compile-lexvar-on-stack-p var)
+              (byte-compile-lforminfo-add-var lforminfo (car var) t)))
+          ;; Analyze the body
+          (unless (null (byte-compile-lforminfo-vars lforminfo))
+            (byte-compile-lforminfo-analyze lforminfo form nil nil))
+          ;; If the analysis revealed some argument need to be in a heap
+          ;; environment (because they're closed over by an embedded
+          ;; lambda), put them there.
+          (setq byte-compile-lexical-environment
+                (nconc (byte-compile-maybe-push-heap-environment lforminfo)
+                       byte-compile-lexical-environment))
+          (dolist (arginfo (byte-compile-lforminfo-vars lforminfo))
+            (when (byte-compile-lvarinfo-closed-over-p arginfo)
+              (byte-compile-bind (car arginfo)
+                                 byte-compile-lexical-environment
+                                 lforminfo)))))
+      ;; Now compile FORM
+      (byte-compile-form form for-effect)
+      (byte-compile-out-toplevel for-effect output-type))))
 
 (defun byte-compile-out-toplevel (&optional for-effect output-type)
   (if for-effect
@@ -2761,7 +2964,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))
          (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
                 (when (symbolp form)
@@ -2771,7 +2973,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                 (when (symbolp form)
                   (byte-compile-set-symbol-position form))
                 (setq for-effect nil))
-               (t (byte-compile-variable-ref 'byte-varref form))))
+               (t
+                (byte-compile-variable-ref form))))
         ((symbolp (car form))
          (let* ((bytecomp-fn (car form))
                 (bytecomp-handler (get bytecomp-fn 'byte-compile)))
@@ -2822,44 +3025,98 @@ That command is designed for interactive use only" bytecomp-fn))
   (mapc 'byte-compile-form (cdr form))  ; wasteful, but faster.
   (byte-compile-out 'byte-call (length (cdr form))))
 
-(defun byte-compile-variable-ref (base-op bytecomp-var)
-  (when (symbolp bytecomp-var)
-    (byte-compile-set-symbol-position bytecomp-var))
-  (if (or (not (symbolp bytecomp-var))
-          (byte-compile-const-symbol-p bytecomp-var
-                                       (not (eq base-op 'byte-varref))))
-      (if (byte-compile-warning-enabled-p 'constants)
-          (byte-compile-warn
-           (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
-                 ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
-                 (t "variable reference to %s `%s'"))
-           (if (symbolp bytecomp-var) "constant" "nonvariable")
-           (prin1-to-string bytecomp-var)))
-    (and (get bytecomp-var 'byte-obsolete-variable)
-         (not (memq bytecomp-var byte-compile-not-obsolete-vars))
-         (byte-compile-warn-obsolete bytecomp-var))
-    (if (eq base-op 'byte-varbind)
-        (push bytecomp-var byte-compile-bound-variables)
-      (or (not (byte-compile-warning-enabled-p 'free-vars))
-          (boundp bytecomp-var)
-          (memq bytecomp-var byte-compile-bound-variables)
-          (if (eq base-op 'byte-varset)
-              (or (memq bytecomp-var byte-compile-free-assignments)
-                  (progn
-                    (byte-compile-warn "assignment to free variable `%s'"
-                                       bytecomp-var)
-                    (push bytecomp-var byte-compile-free-assignments)))
-            (or (memq bytecomp-var byte-compile-free-references)
-                (progn
-                  (byte-compile-warn "reference to free variable `%s'"
-                                     bytecomp-var)
-                  (push bytecomp-var byte-compile-free-references)))))))
-  (let ((tmp (assq bytecomp-var byte-compile-variables)))
+(defun byte-compile-check-variable (var &optional binding)
+  "Do various error checks before a use of the variable VAR.
+If BINDING is non-nil, VAR is being bound."
+  (when (symbolp var)
+    (byte-compile-set-symbol-position var))
+  (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+         (when (byte-compile-warning-enabled-p 'constants)
+           (byte-compile-warn (if binding
+                                  "attempt to let-bind %s `%s`"
+                                "variable reference to %s `%s'")
+                              (if (symbolp var) "constant" "nonvariable")
+                              (prin1-to-string var))))
+        ((and (get var 'byte-obsolete-variable)
+              (not (eq var byte-compile-not-obsolete-var)))
+         (byte-compile-warn-obsolete var))))
+
+(defsubst byte-compile-dynamic-variable-op (base-op var)
+  (let ((tmp (assq var byte-compile-variables)))
     (unless tmp
-      (setq tmp (list bytecomp-var))
+      (setq tmp (list var))
       (push tmp byte-compile-variables))
     (byte-compile-out base-op tmp)))
 
+(defun byte-compile-dynamic-variable-bind (var)
+  "Generate code to bind the lexical variable VAR to the top-of-stack value."
+  (byte-compile-check-variable var t)
+  (when (byte-compile-warning-enabled-p 'free-vars)
+    (push var byte-compile-bound-variables))
+  (byte-compile-dynamic-variable-op 'byte-varbind var))
+
+;; This is used when it's know that VAR _definitely_ has a lexical
+;; binding, and no error-checking should be done.
+(defun byte-compile-lexical-variable-ref (var)
+  "Generate code to push the value of the lexical variable VAR on the stack."
+  (let ((binding (assq var byte-compile-lexical-environment)))
+    (when (null binding)
+      (error "Lexical binding not found for `%s'" var))
+    (if (byte-compile-lexvar-on-stack-p binding)
+        ;; On the stack
+        (byte-compile-stack-ref (byte-compile-lexvar-offset binding))
+      ;; In a heap environment vector; first push the vector on the stack
+      (byte-compile-lexical-variable-ref
+       (byte-compile-lexvar-environment binding))
+      ;; Now get the value from it
+      (byte-compile-out 'byte-vec-ref (byte-compile-lexvar-offset binding)))))
+
+(defun byte-compile-variable-ref (var)
+  "Generate code to push the value of the variable VAR on the stack."
+  (byte-compile-check-variable var)
+  (let ((lex-binding (assq var byte-compile-lexical-environment)))
+    (if lex-binding
+        ;; VAR is lexically bound
+        (if (byte-compile-lexvar-on-stack-p lex-binding)
+            ;; On the stack
+            (byte-compile-stack-ref (byte-compile-lexvar-offset lex-binding))
+          ;; In a heap environment vector
+          (byte-compile-lexical-variable-ref
+           (byte-compile-lexvar-environment lex-binding))
+          (byte-compile-out 'byte-vec-ref 
+                            (byte-compile-lexvar-offset lex-binding)))
+      ;; VAR is dynamically bound
+      (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+                  (boundp var)
+                  (memq var byte-compile-bound-variables)
+                  (memq var byte-compile-free-references))
+        (byte-compile-warn "reference to free variable `%s'" var)
+        (push var byte-compile-free-references))
+      (byte-compile-dynamic-variable-op 'byte-varref var))))
+
+(defun byte-compile-variable-set (var)
+  "Generate code to set the variable VAR from the top-of-stack value."
+  (byte-compile-check-variable var)
+  (let ((lex-binding (assq var byte-compile-lexical-environment)))
+    (if lex-binding
+        ;; VAR is lexically bound
+        (if (byte-compile-lexvar-on-stack-p lex-binding)
+            ;; On the stack
+            (byte-compile-stack-set (byte-compile-lexvar-offset lex-binding))
+          ;; In a heap environment vector
+          (byte-compile-lexical-variable-ref
+           (byte-compile-lexvar-environment lex-binding))
+          (byte-compile-out 'byte-vec-set
+                            (byte-compile-lexvar-offset lex-binding)))
+      ;; VAR is dynamically bound
+      (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+                  (boundp var)
+                  (memq var byte-compile-bound-variables)
+                  (memq var byte-compile-free-assignments))
+        (byte-compile-warn "assignment to free variable `%s'" var)
+        (push var byte-compile-free-assignments))
+      (byte-compile-dynamic-variable-op 'byte-varset var))))
+
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
            ;; In a string constant, treat properties as significant.
@@ -2886,6 +3143,25 @@ That command is designed for interactive use only" bytecomp-fn))
   (let ((for-effect nil))
     (inline (byte-compile-constant const))))
 
+(defun byte-compile-push-unknown-constant (&optional id)
+  "Generate code to push a `constant' who's value isn't known yet.
+A tag is returned which may then later be passed to
+`byte-compile-resolve-unknown-constant' to finalize the value.
+The optional argument ID is a tag returned by an earlier call to
+`byte-compile-push-unknown-constant', in which case the same constant is
+pushed again."
+  (unless id
+    (setq id (list (make-symbol "unknown")))
+    (push id byte-compile-constants))
+  (byte-compile-out 'byte-constant id)
+  id)
+
+(defun byte-compile-resolve-unknown-constant (id value)
+  "Give an `unknown constant' a value.
+ID is the tag returned by `byte-compile-push-unknown-constant'.  and VALUE
+is the value it should have."
+  (setcar id value))
+
 
 ;; Compile those primitive ordinary functions
 ;; which have special byte codes just for speed.
@@ -3089,8 +3365,39 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 (defun byte-compile-noop (form)
   (byte-compile-constant nil))
 
-(defun byte-compile-discard ()
-  (byte-compile-out 'byte-discard 0))
+(defun byte-compile-discard (&optional num preserve-tos)
+  "Output byte codes to discard the NUM entries at the top of the stack (NUM defaults to 1).
+If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were
+popped before discarding the num values, and then pushed back again after
+discarding."
+  (if (and (null num) (not preserve-tos))
+      ;; common case
+      (byte-compile-out 'byte-discard)
+    ;; general case
+    (unless num
+      (setq num 1))
+    (when (and preserve-tos (> num 0))
+      ;; Preserve the top-of-stack value by writing it directly to the stack
+      ;; location which will be at the top-of-stack after popping.
+      (byte-compile-stack-set (1- (- byte-compile-depth num)))
+      ;; Now we actually discard one less value, since we want to keep
+      ;; the eventual TOS
+      (setq num (1- num)))
+    (while (> num 0)
+      (byte-compile-out 'byte-discard)
+      (setq num (1- num)))))
+
+(defun byte-compile-stack-ref (stack-pos)
+  "Output byte codes to push the value at position STACK-POS in the stack, on the top of the stack."
+  (if (= byte-compile-depth (1+ stack-pos))
+      ;; A simple optimization
+      (byte-compile-out 'byte-dup)
+    ;; normal case
+    (byte-compile-out 'byte-stack-ref stack-pos)))
+
+(defun byte-compile-stack-set (stack-pos)
+  "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
+  (byte-compile-out 'byte-stack-set stack-pos))
 
 
 ;; Compile a function that accepts one or more args and is right-associative.
@@ -3249,40 +3556,14 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
      the syntax (function (lambda (...) ...)) instead.")))))
   (byte-compile-two-args form))
 
-(defun byte-compile-funarg (form)
-  ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
-  ;; for cases where it's guaranteed that first arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 1 form)))
-     (if (and (eq (car-safe fn) 'quote)
-              (eq (car-safe (nth 1 fn)) 'lambda))
-         (cons (car form)
-               (cons (cons 'function (cdr fn))
-                     (cdr (cdr form))))
-       form))))
-
-(defun byte-compile-funarg-2 (form)
-  ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
-  ;; for cases where it's guaranteed that second arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 2 form)))
-     (if (and (eq (car-safe fn) 'quote)
-              (eq (car-safe (nth 1 fn)) 'lambda))
-         (cons (car form)
-               (cons (nth 1 form)
-                     (cons (cons 'function (cdr fn))
-                           (cdr (cdr (cdr form))))))
-       form))))
-
 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
 ;; Otherwise it will be incompatible with the interpreter,
 ;; and (funcall (function foo)) will lose with autoloads.
 
 (defun byte-compile-function-form (form)
-  (byte-compile-constant
-   (cond ((symbolp (nth 1 form))
-          (nth 1 form))
-         ((byte-compile-lambda (nth 1 form))))))
+  (if (symbolp (nth 1 form))
+      (byte-compile-constant (nth 1 form))
+    (byte-compile-closure (nth 1 form))))
 
 (defun byte-compile-indent-to (form)
   (let ((len (length form)))
@@ -3326,7 +3607,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
           (byte-compile-form (car (cdr bytecomp-args)))
           (or for-effect (cdr (cdr bytecomp-args))
               (byte-compile-out 'byte-dup 0))
-          (byte-compile-variable-ref 'byte-varset (car bytecomp-args))
+          (byte-compile-variable-set (car bytecomp-args))
           (setq bytecomp-args (cdr (cdr bytecomp-args))))
       ;; (setq), with no arguments.
       (byte-compile-form nil for-effect))
@@ -3392,16 +3673,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 (byte-defop-compiler-1 or)
 (byte-defop-compiler-1 while)
 (byte-defop-compiler-1 funcall)
-(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
-(byte-defop-compiler-1 mapatoms byte-compile-funarg)
-(byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 mapc byte-compile-funarg)
-(byte-defop-compiler-1 maphash byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
-;; map-charset-chars should be funarg but has optional third arg
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)
 
@@ -3583,7 +3854,14 @@ that suppresses all warnings during execution of BODY."
 
 (defun byte-compile-while (form)
   (let ((endtag (byte-compile-make-tag))
-        (looptag (byte-compile-make-tag)))
+        (looptag (byte-compile-make-tag))
+        ;; Heap environments can't be shared between a loop and its
+        ;; enclosing environment (because any lexical variables bound
+        ;; inside the loop should have an independent value for each
+        ;; iteration).  Setting `byte-compile-current-num-closures' to
+        ;; an invalid value causes the code that tries to merge
+        ;; environments to not do so.
+        (byte-compile-current-num-closures -1))
     (byte-compile-out-tag looptag)
     (byte-compile-form (car (cdr form)))
     (byte-compile-goto-if nil for-effect endtag)
@@ -3596,34 +3874,116 @@ that suppresses all warnings during execution of BODY."
   (mapc 'byte-compile-form (cdr form))
   (byte-compile-out 'byte-call (length (cdr (cdr form)))))
 
+
+;; let binding
+
+;; All other lexical-binding functions are guarded by a non-nil return
+;; value from `byte-compile-compute-lforminfo', so they needn't be
+;; autoloaded.
+(autoload 'byte-compile-compute-lforminfo "byte-lexbind")
+
+(defun byte-compile-push-binding-init (clause init-lexenv lforminfo)
+  "Emit byte-codes to push the initialization value for CLAUSE on the stack.
+INIT-LEXENV is the lexical environment created for initializations
+already done for this form.
+LFORMINFO should be information about lexical variables being bound.
+Return INIT-LEXENV updated to include the newest initialization, or nil
+if LFORMINFO is nil (meaning all bindings are dynamic)."
+  (let* ((var (if (consp clause) (car clause) clause))
+         (vinfo
+          (and lforminfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+         (unused (and vinfo (zerop (cadr vinfo)))))
+    (unless (and unused (symbolp clause))
+      (when (and lforminfo (not unused))
+        ;; We record the stack position even of dynamic bindings and
+        ;; variables in non-stack lexical environments; we'll put
+        ;; them in the proper place below.
+        (push (byte-compile-make-lexvar var byte-compile-depth) init-lexenv))
+      (if (consp clause)
+          (byte-compile-form (cadr clause) unused)
+        (byte-compile-push-constant nil))))
+  init-lexenv)
 
 (defun byte-compile-let (form)
-  ;; First compute the binding values in the old scope.
-  (let ((varlist (car (cdr form))))
-    (dolist (var varlist)
-      (if (consp var)
-          (byte-compile-form (car (cdr var)))
-        (byte-compile-push-constant nil))))
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-        (varlist (reverse (car (cdr form)))))
-    (dolist (var varlist)
-        (byte-compile-variable-ref 'byte-varbind
-                                   (if (consp var) (car var) var)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+  "Generate code for the `let' form FORM."
+  (let ((clauses (cadr form))
+        (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+        (init-lexenv nil)
+        ;; bind these to restrict the scope of any changes
+        (byte-compile-current-heap-environment
+         byte-compile-current-heap-environment)
+        (byte-compile-current-num-closures byte-compile-current-num-closures))
+    (when (and lforminfo (byte-compile-non-stack-bindings-p clauses lforminfo))
+      ;; Some of the variables we're binding are lexical variables on
+      ;; the stack, but not all.  As much as we can, rearrange the list
+      ;; so that non-stack lexical variables and dynamically bound
+      ;; variables come last, which allows slightly more optimal
+      ;; byte-code for binding them.
+      (setq clauses (byte-compile-rearrange-let-clauses clauses lforminfo)))
+    ;; If necessary, create a new heap environment to hold some of the
+    ;; variables bound here.
+    (when lforminfo 
+      (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+    ;; First compute the binding values in the old scope.
+    (dolist (clause clauses)
+      (setq init-lexenv
+            (byte-compile-push-binding-init clause init-lexenv lforminfo)))
+    ;; Now do the bindings, execute the body, and undo the bindings
+    (let ((byte-compile-bound-variables byte-compile-bound-variables)
+          (byte-compile-lexical-environment byte-compile-lexical-environment)
+          (preserve-body-value (not for-effect)))
+      (dolist (clause (reverse clauses))
+        (let ((var (if (consp clause) (car clause) clause)))
+          (cond ((null lforminfo)
+                 ;; If there are no lexical bindings, we can do things simply.
+                 (byte-compile-dynamic-variable-bind var))
+                ((byte-compile-bind var init-lexenv lforminfo)
+                 (pop init-lexenv)))))
+      ;; Emit the body
+      (byte-compile-body-do-effect (cdr (cdr form)))
+      ;; Unbind the variables
+      (if lforminfo
+          ;; Unbind both lexical and dynamic variables
+         (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+        ;; Unbind dynamic variables
+        (byte-compile-out 'byte-unbind (length clauses))))))
 
 (defun byte-compile-let* (form)
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-        (varlist (copy-sequence (car (cdr form)))))
-    (dolist (var varlist)
-      (if (atom var)
-          (byte-compile-push-constant nil)
-        (byte-compile-form (car (cdr var)))
-        (setq var (car var)))
-      (byte-compile-variable-ref 'byte-varbind var))
+  "Generate code for the `let*' form FORM."
+  (let ((clauses (cadr form))
+        (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+        (init-lexenv nil)
+        (preserve-body-value (not for-effect))
+        ;; bind these to restrict the scope of any changes
+        (byte-compile-bound-variables byte-compile-bound-variables)
+        (byte-compile-lexical-environment byte-compile-lexical-environment)
+        (byte-compile-current-heap-environment
+         byte-compile-current-heap-environment)
+        (byte-compile-current-num-closures byte-compile-current-num-closures))
+    ;; If necessary, create a new heap environment to hold some of the
+    ;; variables bound here.
+    (when lforminfo 
+      (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+    ;; Bind the variables
+    (dolist (clause clauses)
+      (setq init-lexenv
+            (byte-compile-push-binding-init clause init-lexenv lforminfo))
+      (let ((var (if (consp clause) (car clause) clause)))
+        (cond ((null lforminfo)
+               ;; If there are no lexical bindings, we can do things simply.
+               (byte-compile-dynamic-variable-bind var))
+              ((byte-compile-bind var init-lexenv lforminfo)
+               (pop init-lexenv)))))
+    ;; Emit the body
     (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+    ;; Unbind the variables
+    (if lforminfo
+        ;; Unbind both lexical and dynamic variables
+        (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+      ;; Unbind dynamic variables
+      (byte-compile-out 'byte-unbind (length clauses)))))
 
+
 
 (byte-defop-compiler-1 /= byte-compile-negated)
 (byte-defop-compiler-1 atom byte-compile-negated)
@@ -3646,6 +4006,7 @@ that suppresses all warnings during execution of BODY."
                "Compiler error: `%s' has no `byte-compile-negated-op' property"
                (car form)))
           (cdr form))))
+
 
 ;;; other tricky macro-like special-forms
 
@@ -3766,28 +4127,28 @@ that suppresses all warnings during execution of BODY."
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
-  ;; We prefer to generate a defalias form so it will record the function
-  ;; definition just like interpreting a defun.
-  (byte-compile-form
-   (list 'defalias
-         (list 'quote (nth 1 form))
-         (byte-compile-byte-code-maker
-          (byte-compile-lambda (cdr (cdr form)) t)))
-   t)
-  (byte-compile-constant (nth 1 form)))
+  (let ((for-effect nil))
+    (byte-compile-push-constant 'defalias)
+    (byte-compile-push-constant (nth 1 form))
+    (byte-compile-closure (cdr (cdr form)) t))
+  (byte-compile-out 'byte-call 2))
 
 (defun byte-compile-defmacro (form)
   ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (let ((decls (byte-compile-defmacro-declaration form))
-         (code (byte-compile-byte-code-maker
-                (byte-compile-lambda (cdr (cdr form)) t))))
-     `((defalias ',(nth 1 form)
-         ,(if (eq (car-safe code) 'make-byte-code)
-              `(cons 'macro ,code)
-            `'(macro . ,(eval code))))
-       ,@decls
-       ',(nth 1 form)))))
+  ;; FIXME handle decls, use defalias?
+  (let ((decls (byte-compile-defmacro-declaration form))
+        (code (byte-compile-lambda (cdr (cdr form)) t))
+        (for-effect nil))
+    (byte-compile-push-constant (nth 1 form))
+    (if (not (byte-compile-closure-code-p code))
+        ;; simple lambda
+        (byte-compile-push-constant (cons 'macro code))
+      (byte-compile-push-constant 'macro)
+      (byte-compile-make-closure code)
+      (byte-compile-out 'byte-cons))
+    (byte-compile-out 'byte-fset)
+    (byte-compile-discard))
+  (byte-compile-constant (nth 1 form)))
 
 (defun byte-compile-defvar (form)
   ;; This is not used for file-level defvar/consts with doc strings.
@@ -3813,7 +4174,7 @@ that suppresses all warnings during execution of BODY."
       ;; Put the defined variable in this library's load-history entry
       ;; just as a real defvar would, but only in top-level forms.
       (when (and (cddr form) (null byte-compile-current-form))
-        `(push ',var current-load-list))
+        `(setq current-load-list (cons ',var current-load-list)))
       (when (> (length form) 3)
         (when (and string (not (stringp string)))
             (byte-compile-warn "third arg to `%s %s' is not a string: %s"
@@ -3935,23 +4296,74 @@ that suppresses all warnings during execution of BODY."
   (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
                                 (1- byte-compile-depth))))
 
-(defun byte-compile-out (opcode offset)
-  (push (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))))
-  ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
-  )
+(defun byte-compile-stack-adjustment (op operand)
+  "Return the amount by which an operation adjusts the stack.
+OP and OPERAND are as passed to `byte-compile-out'."
+  (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
+      ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
+      ;; elements, and the push the result, for a total of -OPERAND.
+      ;; For discardN*, of course, we just pop OPERAND elements.
+      (- operand)
+    (or (aref byte-stack+-info (symbol-value op))
+        ;; Ops with a nil entry in `byte-stack+-info' are byte-codes
+        ;; that take OPERAND values off the stack and push a result, for
+        ;; a total of 1 - OPERAND
+        (- 1 operand))))
+  
+(defun byte-compile-out (op &optional operand)
+  (push (cons op operand) byte-compile-output)
+  (if (eq op 'byte-return)
+      ;; This is actually an unnecessary case, because there should be no
+      ;; more ops behind byte-return.
+      (setq byte-compile-depth nil)
+    (setq byte-compile-depth
+          (+ byte-compile-depth (byte-compile-stack-adjustment op operand)))
+    (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
+    ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
+    ))
+
+(defun byte-compile-delay-out (&optional stack-used stack-adjust)
+  "Add a placeholder to the output, which can be used to later add byte-codes.
+Return a position tag that can be passed to `byte-compile-delayed-out'
+to add the delayed byte-codes.  STACK-USED is the maximum amount of
+stack-spaced used by the delayed byte-codes (defaulting to 0), and
+STACK-ADJUST is the amount by which the later-added code will adjust the
+stack (defaulting to 0); the byte-codes added later _must_ adjust the
+stack by this amount!  If STACK-ADJUST is 0, then it's not necessary to
+actually add anything later; the effect as if nothing was added at all."
+  ;; We just add a no-op to `byte-compile-output', and return a pointer to
+  ;; the tail of the list; `byte-compile-delayed-out' uses list surgery
+  ;; to add the byte-codes.
+  (when stack-used
+    (setq byte-compile-maxdepth
+          (max byte-compile-depth (+ byte-compile-depth (or stack-used 0)))))
+  (when stack-adjust
+    (setq byte-compile-depth
+          (+ byte-compile-depth stack-adjust)))
+  (push (cons nil (or stack-adjust 0)) byte-compile-output))
+
+(defun byte-compile-delayed-out (position op &optional operand)
+  "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND.
+POSITION should a position returned by `byte-compile-delay-out'.
+Return a new position, which can be used to add further operations."
+  (unless (null (caar position))
+    (error "Bad POSITION arg to `byte-compile-delayed-out'"))
+  ;; This is kind of like `byte-compile-out', but we splice into the list
+  ;; where POSITION is.  We don't bother updating `byte-compile-maxdepth'
+  ;; because that was already done by `byte-compile-delay-out', but we do
+  ;; update the relative operand stored in the no-op marker currently at
+  ;; POSITION; since we insert before that marker, this means that if the
+  ;; caller doesn't insert a sequence of byte-codes that matches the expected
+  ;; operand passed to `byte-compile-delay-out', then the nop will still have
+  ;; a non-zero operand when `byte-compile-lapcode' is called, which will
+  ;; cause an error to be signaled.
+
+  ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op
+  (setcdr (car position)
+          (- (cdar position) (byte-compile-stack-adjustment op operand)))
+  ;; Add the new operation onto the list tail at POSITION
+  (setcdr position (cons (cons op operand) (cdr position)))
+  position)
 
 
 ;;; call tree stuff
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 9899e991e3f..18aa5fde0c8 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -73,19 +73,22 @@ redefine OBJECT if it is a symbol."
   (let ((macro 'nil)
         (name 'nil)
         (doc 'nil)
+        (lexical-binding nil)
         args)
     (while (symbolp obj)
       (setq name obj
             obj (symbol-function obj)))
     (if (subrp obj)
         (error "Can't disassemble #<subr %s>" name))
-    (if (and (listp obj) (eq (car obj) 'autoload))
-        (progn
-          (load (nth 1 obj))
-          (setq obj (symbol-function name))))
+    (when (and (listp obj) (eq (car obj) 'autoload))
+      (load (nth 1 obj))
+      (setq obj (symbol-function name)))
     (if (eq (car-safe obj) 'macro)      ;handle macros
         (setq macro t
               obj (cdr obj)))
+    (when (and (listp obj) (eq (car obj) 'closure))
+      (setq lexical-binding t)
+      (setq obj (cddr obj)))
     (if (and (listp obj) (eq (car obj) 'byte-code))
         (setq obj (list 'lambda nil obj)))
     (if (and (listp obj) (not (eq (car obj) 'lambda)))
@@ -216,7 +219,9 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
           (cond ((memq op byte-goto-ops)
                  (insert (int-to-string (nth 1 arg))))
                 ((memq op '(byte-call byte-unbind
-                            byte-listN byte-concatN byte-insertN))
+                            byte-listN byte-concatN byte-insertN
+                            byte-stack-ref byte-stack-set byte-stack-set2
+                            byte-discardN byte-discardN-preserve-tos))
                  (insert (int-to-string arg)))
                 ((memq op '(byte-varref byte-varset byte-varbind))
                  (prin1 (car arg) (current-buffer)))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 02477baf74f..1185f79806f 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -701,7 +701,15 @@ If CHAR is not a character, return nil."
 (defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
   "Evaluate sexp before point; print value in minibuffer.
 With argument, print output into current buffer."
-  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
+  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
+        ;; preserve the current lexical environment
+        (internal-interpreter-environment internal-interpreter-environment))
+    ;; Setup the lexical environment if lexical-binding is enabled.
+    ;; Note that `internal-interpreter-environment' _can't_ be both
+    ;; assigned and let-bound above -- it's treated specially (and
+    ;; oddly) by the interpreter!
+    (when lexical-binding
+      (setq internal-interpreter-environment '(t)))
     (eval-last-sexp-print-value (eval (preceding-sexp)))))
 
 
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 86e9411b140..9a505b214c8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -100,6 +100,8 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
   (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
   ;; If definition is a macro, find the function inside it.
   (if (eq (car-safe def) 'macro) (setq def (cdr def)))
+  ;; and do the same for interpreted closures
+  (if (eq (car-safe def) 'closure) (setq def (cddr def)))
   (cond
    ((byte-code-function-p def) (aref def 0))
    ((eq (car-safe def) 'lambda) (nth 1 def))
@@ -190,7 +192,7 @@ if the variable `help-downcase-arguments' is non-nil."
                  doc t t 1)))))
 
 (defun help-highlight-arguments (usage doc &rest args)
-  (when usage
+  (when (and usage (string-match "^(" usage))
     (with-temp-buffer
       (insert usage)
       (goto-char (point-min))
@@ -347,8 +349,7 @@ suitable file is found, return nil."
          (pt1 (with-current-buffer (help-buffer) (point)))
          errtype)
     (setq string
-          (cond ((or (stringp def)
-                     (vectorp def))
+          (cond ((or (stringp def) (vectorp def))
                  "a keyboard macro")
                 ((subrp def)
                  (if (eq 'unevalled (cdr (subr-arity def)))
@@ -356,6 +357,13 @@ suitable file is found, return nil."
                    (concat beg "built-in function")))
                 ((byte-code-function-p def)
                  (concat beg "compiled Lisp function"))
+                ((and (funvecp def) (eq (aref def 0) 'curry))
+                 (if (symbolp (aref def 1))
+                     (format "a curried function calling `%s'" (aref def 1))
+                   "a curried function"))
+                ((funvecp def)
+                 (format "a function-vector (funvec) of type `%s'"
+                         (aref def 0)))
                 ((symbolp def)
                  (while (and (fboundp def)
                              (symbolp (symbol-function def)))
@@ -367,6 +375,8 @@ suitable file is found, return nil."
                  (concat beg "Lisp function"))
                 ((eq (car-safe def) 'macro)
                  "a Lisp macro")
+                ((eq (car-safe def) 'closure)
+                 (concat beg "Lisp closure"))
                 ((eq (car-safe def) 'autoload)
                  (format "%s autoloaded %s"
                          (if (commandp def) "an interactive" "an")
@@ -494,27 +504,42 @@ suitable file is found, return nil."
                          ((or (stringp def)
                               (vectorp def))
                           (format "\nMacro: %s" (format-kbd-macro def)))
+                         ((and (funvecp def) (eq (aref def 0) 'curry))
+                          ;; Describe a curried-function's function and args
+                          (let ((slot 0))
+                            (mapconcat (lambda (arg)
+                                         (setq slot (1+ slot))
+                                         (cond
+                                          ((= slot 1) "")
+                                          ((= slot 2)
+                                           (format "  Function: %S" arg))
+                                          (t
+                                           (format "Argument %d: %S"
+                                                   (- slot 3) arg))))
+                                       def
+                                       "\n")))
+                         ((funvecp def) nil)
                          (t "[Missing arglist.  Please make a bug report.]")))
                    (high (help-highlight-arguments use doc)))
               (let ((fill-begin (point)))
                 (insert (car high) "\n")
-                (fill-region fill-begin (point)))
-              (setq doc (cdr high))))
-          (let* ((obsolete (and
-                            ;; function might be a lambda construct.
-                            (symbolp function)
-                            (get function 'byte-obsolete-info)))
-                 (use (car obsolete)))
-            (when obsolete
-              (princ "\nThis function is obsolete")
-              (when (nth 2 obsolete)
-                (insert (format " since %s" (nth 2 obsolete))))
-              (insert (cond ((stringp use) (concat ";\n" use))
-                            (use (format ";\nuse `%s' instead." use))
-                            (t "."))
-                      "\n"))
-            (insert "\n"
-                    (or doc "Not documented."))))))))
+                (fill-region fill-begin (point))))
+            (setq doc (cdr high))))
+        (let* ((obsolete (and
+                          ;; function might be a lambda construct.
+                          (symbolp function)
+                          (get function 'byte-obsolete-info)))
+               (use (car obsolete)))
+          (when obsolete
+            (princ "\nThis function is obsolete")
+            (when (nth 2 obsolete)
+              (insert (format " since %s" (nth 2 obsolete))))
+            (insert (cond ((stringp use) (concat ";\n" use))
+                          (use (format ";\nuse `%s' instead." use))
+                          (t "."))
+                    "\n"))
+          (insert "\n"
+                  (or doc "Not documented.")))))))
 
 
 ;; Variables
diff --git a/lisp/subr.el b/lisp/subr.el
index 16ba45f1c74..61a226c20ff 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -427,6 +427,12 @@ Non-strings in LIST are ignored."
     (setq list (cdr list)))
   list)
 
+(defmacro with-lexical-binding (&rest body)
+  "Execute the statements in BODY using lexical binding."
+  `(let ((internal-interpreter-environment internal-interpreter-environment))
+     (setq internal-interpreter-environment '(t))
+     ,@body))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.