+2011-02-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-lexbind.el: Delete.
+
+ * emacs-lisp/bytecomp.el (byte-compile-current-heap-environment)
+ (byte-compile-current-num-closures): Remove vars.
+ (byte-vec-ref, byte-vec-set): Remove byte codes.
+ (byte-compile-arglist-vars, byte-compile-make-lambda-lexenv): Move from
+ byte-lexbind.el.
+ (byte-compile-lambda): Never build a closure.
+ (byte-compile-closure-code-p, byte-compile-make-closure): Remove.
+ (byte-compile-closure): Simplify.
+ (byte-compile-top-level): Don't mess with heap environments.
+ (byte-compile-dynamic-variable-bind): Always maintain
+ byte-compile-bound-variables.
+ (byte-compile-variable-ref, byte-compile-variable-set): Always just use
+ the stack for lexical vars.
+ (byte-compile-push-binding-init): Simplify.
+ (byte-compile-not-lexical-var-p): New function, moved from cconv.el.
+ (byte-compile-bind, byte-compile-unbind): New functions, moved and
+ simplified from byte-lexbind.el.
+ (byte-compile-let, byte-compile-let*): Simplify.
+ (byte-compile-condition-case): Don't add :fun-body to the bound vars.
+ (byte-compile-defmacro): Simplify.
+
+ * emacs-lisp/cconv.el (cconv-not-lexical-var-p): Remove.
+ (cconv-freevars, cconv-analyse-function, cconv-analyse-form):
+ Use byte-compile-not-lexical-var-p instead.
+
+ * help-fns.el (describe-function-1): Fix paren typo.
+
+ * emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops)
+ (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set.
+
2011-02-11 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg.
+++ /dev/null
-;;; byte-lexbind.el --- Lexical binding support for byte-compiler
-;;
-;; Copyright (C) 2001, 2002, 2010, 2011 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 3, 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)))
-
-\f
-;;; 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 (special-variable-p 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 (special-variable-p 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)))))))
- ((and (eq fun 'catch) (not (eq :fun-body (nth 2 form))))
- ;; 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 (eq (nth 1 form) :fun-body)
- 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
- )
- ((and (eq fun 'save-window-excursion)
- (not (eq :fun-body (nth 1 form))))
- ;; `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)))))
-
-\f
-;;; 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))
-
-\f
-;;; 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))))
-
-\f
-;;; 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)
- (zerop nclosures)
- (= nclosures byte-compile-current-num-closures))
- ;; No need to push a heap environment.
- nil
- (error "Should have been handled by cconv")
- ;; 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)
-
-;;; byte-lexbind.el ends here
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-vec-ref)
+ byte-member byte-assq byte-quo byte-rem)
byte-compile-side-effect-and-error-free-ops))
;; This crock is because of the way DEFVAR_BOOL variables work.
;;
((and (eq 'byte-dup (car lap0))
(eq 'byte-discard (car lap2))
- (memq (car lap1) '(byte-varset byte-varbind byte-stack-set byte-vec-set)))
+ (memq (car lap1) '(byte-varset byte-varbind byte-stack-set)))
(byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
(setq keep-going t
rest (cdr rest)
;; 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 nil 'noerror))
-
;; 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."
:type '(choice (const name) (const callers) (const calls)
(const calls+callers) (const nil)))
-;(defvar byte-compile-debug nil)
(defvar byte-compile-debug t)
(setq debug-on-error 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
"List of all variables encountered during compilation of this form.")
(defvar byte-compile-bound-variables nil
- "List of variables bound in the context of the current form.
+ "List of dynamic variables bound in the context of the current form.
This list lives partly on the stack.")
(defvar byte-compile-const-variables nil
"List of variables declared as constants during compilation of this file.")
;; 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
(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
(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))
- ((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
- (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))))))
+ (cond
+ ((not (symbolp op))
+ (error "Non-symbolic opcode `%s'" op))
+ ((eq op 'TAG)
+ (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 opcode
+ (if (eq op 'byte-discardN-preserve-tos)
+ ;; byte-discardN-preserve-tos is a pseudo op, which
+ ;; is actually the same as byte-discardN
+ ;; with a modified argument.
+ byte-discardN
+ (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)))
"Non-nil to prevent byte-compiling of Emacs Lisp code.
This is normally set in local file variables at the end of the elisp file:
-;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
+\;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;Backslash for compile-main.
;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load)
(setq list (cdr list)))))
-(autoload 'byte-compile-make-lambda-lexenv "byte-lexbind")
+(defun byte-compile-arglist-vars (arglist)
+ "Return a list of the variables in the lambda argument list ARGLIST."
+ (remq '&rest (remq '&optional arglist)))
+
+(defun byte-compile-make-lambda-lexenv (form)
+ "Return a new lexical environment for a lambda expression FORM."
+ ;; See if this is a closure or not
+ (let ((args (byte-compile-arglist-vars (cadr form))))
+ (let ((lexenv nil))
+ ;; Fill in the initial stack contents
+ (let ((stackpos 0))
+ ;; Add entries for each argument
+ (dolist (arg args)
+ (push (cons arg stackpos) lexenv)
+ (setq stackpos (1+ stackpos)))
+ ;; Return the new lexical environment
+ lexenv))))
;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
(byte-compile-check-lambda-list (nth 1 bytecomp-fun))
(let* ((bytecomp-arglist (nth 1 bytecomp-fun))
(byte-compile-bound-variables
- (nconc (and (byte-compile-warning-enabled-p 'free-vars)
- (delq '&rest
- (delq '&optional (copy-sequence bytecomp-arglist))))
- byte-compile-bound-variables))
+ (append (and (not lexical-binding)
+ (byte-compile-arglist-vars bytecomp-arglist))
+ byte-compile-bound-variables))
(bytecomp-body (cdr (cdr bytecomp-fun)))
(bytecomp-doc (if (stringp (car bytecomp-body))
(prog1 (car bytecomp-body)
;; Process the body.
(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
- bytecomp-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).
+ ;; containing just the args (since lambda expressions
+ ;; should be closed by now).
(and lexical-binding
- (byte-compile-closure-initial-lexenv-p
- byte-compile-lexical-environment)
- (error "Should have been handled by cconv")))
- (byte-compile-current-heap-environment nil)
- (byte-compile-current-num-closures 0)
+ (byte-compile-make-lambda-lexenv bytecomp-fun)))
(compiled
(byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
(if (eq 'byte-code (car-safe compiled))
- (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))
+ (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))))
(setq compiled
(nconc (if bytecomp-int (list bytecomp-int))
(cond ((eq (car-safe compiled) 'progn) (cdr compiled))
(bytecomp-body (list nil))))
compiled))))))
-(defun byte-compile-closure-code-p (code)
- (eq (car-safe code) 'closure))
-
-(defun byte-compile-make-closure (code)
- (error "Should have been handled by cconv")
- ;; 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))))
+ ;; 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.
;; 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))))
+ (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)))))
+ (byte-compile-out-tag (byte-compile-make-tag))))
;; Now compile FORM
(byte-compile-form form for-effect)
(byte-compile-out-toplevel for-effect output-type))))
(if (memq bytecomp-fn
'(custom-declare-group custom-declare-variable
custom-declare-face))
- (byte-compile-nogroup-warn form))
+ (byte-compile-nogroup-warn form))
(byte-compile-callargs-warn form))
(if (and bytecomp-handler
;; Make sure that function exists. This is important
(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))
+ (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)))
+ (byte-compile-stack-ref (cdr lex-binding))
;; VAR is dynamically bound
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
(boundp 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)))
+ (byte-compile-stack-set (cdr lex-binding))
;; VAR is dynamically bound
(unless (or (not (byte-compile-warning-enabled-p 'free-vars))
(boundp var)
,condition (list 'boundp 'default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
- (if bound-list
- (append bound-list byte-compile-bound-variables)
- byte-compile-bound-variables)))
+ (append bound-list byte-compile-bound-variables)))
(unwind-protect
;; If things not being bound at all is ok, so must them being obsolete.
;; Note that we add to the existing lists since Tramp (ab)uses
(defun byte-compile-while (form)
(let ((endtag (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))
+ (looptag (byte-compile-make-tag)))
(byte-compile-out-tag looptag)
(byte-compile-form (car (cdr form)))
(byte-compile-goto-if nil for-effect endtag)
\f
;; 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)
+(defun byte-compile-push-binding-init (clause)
"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))
+Return the offset in the form (VAR . OFFSET)."
+ (let* ((var (if (consp clause) (car clause) clause)))
+ ;; 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.
+ (prog1 (cons var byte-compile-depth)
(if (consp clause)
- (byte-compile-form (cadr clause) unused)
- (byte-compile-push-constant nil))))
- init-lexenv)
+ (byte-compile-form (cadr clause))
+ (byte-compile-push-constant nil)))))
+
+(defun byte-compile-not-lexical-var-p (var)
+ (or (not (symbolp var)) ; form is not a list
+ (if (eval-when-compile (fboundp 'special-variable-p))
+ (special-variable-p var)
+ (boundp var))
+ (memq var byte-compile-bound-variables)
+ (memq var '(nil t))
+ (keywordp var)))
+
+(defun byte-compile-bind (var init-lexenv)
+ "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.
+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.
+ (cond ((not (byte-compile-not-lexical-var-p var))
+ ;; VAR is a simple stack-allocated lexical variable
+ (push (assq var init-lexenv)
+ byte-compile-lexical-environment)
+ nil)
+ ((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)
+ (t
+ ;; 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)))
+
+(defun byte-compile-unbind (clauses init-lexenv
+ &optional 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. 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))
+ (dolist (clause clauses)
+ (unless (assq (if (consp clause) (car clause) clause)
+ byte-compile-lexical-environment)
+ (setq num-dynamic-bindings (1+ num-dynamic-bindings))))
+ (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)))
(defun byte-compile-let (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)
+ ;; First compute the binding values in the old scope.
+ (let ((varlist (car (cdr form)))
+ (init-lexenv nil))
+ (dolist (var varlist)
+ (push (byte-compile-push-binding-init var) init-lexenv))
+ ;; Now do the bindings, execute the body, and undo the bindings.
+ (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
+ (varlist (reverse (car (cdr form))))
+ (byte-compile-lexical-environment byte-compile-lexical-environment))
+ (dolist (var varlist)
+ (let ((var (if (consp var) (car var) var)))
+ (cond ((null lexical-binding)
;; If there are no lexical bindings, we can do things simply.
(byte-compile-dynamic-variable-bind var))
- ((byte-compile-bind var init-lexenv lforminfo)
+ ((byte-compile-bind var init-lexenv)
(pop init-lexenv)))))
- ;; Emit the body
+ ;; 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))))))
+ ;; Unbind the variables.
+ (if lexical-binding
+ ;; Unbind both lexical and dynamic variables.
+ (byte-compile-unbind varlist init-lexenv t)
+ ;; Unbind dynamic variables.
+ (byte-compile-out 'byte-unbind (length varlist))))))
(defun byte-compile-let* (form)
"Generate code for the `let*' form FORM."
- (let ((clauses (cadr form))
- (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+ (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
+ (clauses (cadr 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)))
+
+ (byte-compile-lexical-environment byte-compile-lexical-environment))
;; 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)
+ (dolist (var clauses)
+ (push (byte-compile-push-binding-init var) init-lexenv)
+ (let ((var (if (consp var) (car var) var)))
+ (cond ((null lexical-binding)
;; If there are no lexical bindings, we can do things simply.
(byte-compile-dynamic-variable-bind var))
- ((byte-compile-bind var init-lexenv lforminfo)
+ ((byte-compile-bind var init-lexenv)
(pop init-lexenv)))))
;; Emit the body
(byte-compile-body-do-effect (cdr (cdr form)))
;; Unbind the variables
- (if lforminfo
+ (if lexical-binding
;; Unbind both lexical and dynamic variables
- (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+ (byte-compile-unbind clauses init-lexenv t)
;; Unbind dynamic variables
(byte-compile-out 'byte-unbind (length clauses)))))
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
- (byte-compile-bound-variables
- (if var (cons var byte-compile-bound-variables)
- byte-compile-bound-variables))
- (fun-bodies (eq var :fun-body)))
+ (fun-bodies (eq var :fun-body))
+ (byte-compile-bound-variables
+ (if (and var (not fun-bodies))
+ (cons var byte-compile-bound-variables)
+ byte-compile-bound-variables)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
(byte-compile-warn
(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-push-constant (cons 'macro code))
(byte-compile-out 'byte-fset)
(byte-compile-discard))
(byte-compile-constant (nth 1 form)))
"List of candidates for lambda lifting.
Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
-(defun cconv-not-lexical-var-p (var)
- (or (not (symbolp var)) ; form is not a list
- (if (eval-when-compile (fboundp 'special-variable-p))
- (special-variable-p var)
- (boundp var))
- ;; byte-compile-bound-variables normally holds both the
- ;; dynamic and lexical vars, but the bytecomp.el should
- ;; only call us at the top-level so there shouldn't be
- ;; any lexical vars in it here.
- (memq var byte-compile-bound-variables)
- (memq var '(nil t))
- (keywordp var)))
-
(defun cconv-freevars (form &optional fvrs)
"Find all free variables of given form.
Arguments:
(dolist (exp body-forms)
(setq fvrs (cconv-freevars exp fvrs))) fvrs)
- (_ (if (cconv-not-lexical-var-p form)
+ (_ (if (byte-compile-not-lexical-var-p form)
fvrs
(cons form fvrs)))))
(defun cconv-analyse-function (args body env parentform inclosure)
(dolist (arg args)
(cond
- ((cconv-not-lexical-var-p arg)
+ ((byte-compile-not-lexical-var-p arg)
(byte-compile-report-error
(format "Argument %S is not a lexical variable" arg)))
((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
(cconv-analyse-form value (if (eq letsym 'let*) env orig-env)
inclosure))
- (unless (cconv-not-lexical-var-p var)
+ (unless (byte-compile-not-lexical-var-p var)
(let ((varstruct (list var inclosure binder form)))
(push varstruct env) ; Push a new one.
(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."))))))))
\f
;; Variables
+2011-02-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bytecode.c (Bvec_ref, Bvec_set): Remove.
+ (exec_byte_code): Don't handle them.
+
2010-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (Fdefvar): Record specialness before computing initial value.
/* Bstack_ref is code 0. */
#define Bstack_set 0262
#define Bstack_set2 0263
-#define Bvec_ref 0264
-#define Bvec_set 0265
#define BdiscardN 0266
#define Bconstant 0300
case Bstack_set2:
stack.bottom[FETCH2] = POP;
break;
- case Bvec_ref:
- case Bvec_set:
- /* These byte-codes used mostly for variable references to
- lexically bound variables that are in an environment vector
- instead of on the byte-interpreter stack (generally those
- variables which might be shared with a closure). */
- {
- int index = FETCH;
- Lisp_Object vec = POP;
-
- if (! VECTORP (vec))
- wrong_type_argument (Qvectorp, vec);
- else if (index < 0 || index >= XVECTOR (vec)->size)
- args_out_of_range (vec, make_number (index));
-
- if (op == Bvec_ref)
- PUSH (XVECTOR (vec)->contents[index]);
- else
- XVECTOR (vec)->contents[index] = POP;
- }
- break;
case BdiscardN:
op = FETCH;
if (op & 0x80)
HCoop / bpt / emacs.git / commitdiff