diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-lexbind.el | 699 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 553 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 19 |
4 files changed, 227 insertions, 1048 deletions
diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el deleted file mode 100644 index 06353e2eea8..00000000000 --- a/lisp/emacs-lisp/byte-lexbind.el +++ /dev/null @@ -1,699 +0,0 @@ -;;; 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))) - - -;;; 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))))) - - -;;; 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) - (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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 97ed6a01c2f..71960ad54dc 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1483,7 +1483,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-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. @@ -1671,7 +1671,7 @@ 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 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) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 33940ec160e..e9beb0c5792 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -126,47 +126,11 @@ ;; 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." @@ -439,24 +403,15 @@ 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 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.") @@ -512,10 +467,6 @@ 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 @@ -734,8 +685,6 @@ otherwise pop it") (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 @@ -824,68 +773,71 @@ CONST2 may be evaulated multiple times." (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))) @@ -1694,7 +1646,7 @@ that already has a `.elc' file." "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) @@ -2682,7 +2634,23 @@ 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") +(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 @@ -2700,10 +2668,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." (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) @@ -2742,42 +2709,27 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; 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)) @@ -2788,26 +2740,10 @@ 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) - (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. @@ -2867,34 +2803,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; 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)))) @@ -3044,7 +2957,7 @@ That command is designed for interactive use only" bytecomp-fn)) (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 @@ -3107,40 +3020,16 @@ If BINDING is non-nil, VAR is being bound." (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) @@ -3156,14 +3045,7 @@ If BINDING is non-nil, VAR is being bound." (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) @@ -3795,9 +3677,7 @@ that suppresses all warnings during execution of BODY." ,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 @@ -3910,14 +3790,7 @@ that suppresses all warnings during execution of BODY." (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) @@ -3933,109 +3806,131 @@ that suppresses all warnings during execution of BODY." ;; 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))))) @@ -4105,10 +4000,11 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (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 @@ -4215,12 +4111,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (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))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index efb9d061b5c..10464047cd3 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -85,19 +85,6 @@ is less than this number.") "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: @@ -189,7 +176,7 @@ Returns a list of free variables." (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))))) @@ -704,7 +691,7 @@ Returns a form where all lambdas don't have any free variables." (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, ... @@ -738,7 +725,7 @@ lambdas if they are suitable for lambda lifting. (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. |