aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-02-12 00:53:30 -0500
committerStefan Monnier2011-02-12 00:53:30 -0500
commitce5b520a3758e22c6516e0d864d8c1a3512bf457 (patch)
treebcf74ea6c4f88995c5630113578632dc4ce2a878
parentc530e1c2a3a036d71942c354ba11b30a06341fd7 (diff)
downloademacs-ce5b520a3758e22c6516e0d864d8c1a3512bf457.tar.gz
emacs-ce5b520a3758e22c6516e0d864d8c1a3512bf457.zip
* lisp/emacs-lisp/byte-lexbind.el: Delete.
* lisp/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. * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops) (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set. * lisp/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. * src/bytecode.c (Bvec_ref, Bvec_set): Remove. (exec_byte_code): Don't handle them. * lisp/help-fns.el (describe-function-1): Fix paren typo.
Diffstat
-rw-r--r--lisp/ChangeLog34
-rw-r--r--lisp/emacs-lisp/byte-lexbind.el699
-rw-r--r--lisp/emacs-lisp/byte-opt.el4
-rw-r--r--lisp/emacs-lisp/bytecomp.el553
-rw-r--r--lisp/emacs-lisp/cconv.el19
-rw-r--r--lisp/help-fns.el34
-rw-r--r--src/ChangeLog5
-rw-r--r--src/bytecode.c23
8 files changed, 283 insertions, 1088 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c3451d9b269..b972f17909a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,37 @@
12011-02-12 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/byte-lexbind.el: Delete.
4
5 * emacs-lisp/bytecomp.el (byte-compile-current-heap-environment)
6 (byte-compile-current-num-closures): Remove vars.
7 (byte-vec-ref, byte-vec-set): Remove byte codes.
8 (byte-compile-arglist-vars, byte-compile-make-lambda-lexenv): Move from
9 byte-lexbind.el.
10 (byte-compile-lambda): Never build a closure.
11 (byte-compile-closure-code-p, byte-compile-make-closure): Remove.
12 (byte-compile-closure): Simplify.
13 (byte-compile-top-level): Don't mess with heap environments.
14 (byte-compile-dynamic-variable-bind): Always maintain
15 byte-compile-bound-variables.
16 (byte-compile-variable-ref, byte-compile-variable-set): Always just use
17 the stack for lexical vars.
18 (byte-compile-push-binding-init): Simplify.
19 (byte-compile-not-lexical-var-p): New function, moved from cconv.el.
20 (byte-compile-bind, byte-compile-unbind): New functions, moved and
21 simplified from byte-lexbind.el.
22 (byte-compile-let, byte-compile-let*): Simplify.
23 (byte-compile-condition-case): Don't add :fun-body to the bound vars.
24 (byte-compile-defmacro): Simplify.
25
26 * emacs-lisp/cconv.el (cconv-not-lexical-var-p): Remove.
27 (cconv-freevars, cconv-analyse-function, cconv-analyse-form):
28 Use byte-compile-not-lexical-var-p instead.
29
30 * help-fns.el (describe-function-1): Fix paren typo.
31
32 * emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops)
33 (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set.
34
12011-02-11 Stefan Monnier <monnier@iro.umontreal.ca> 352011-02-11 Stefan Monnier <monnier@iro.umontreal.ca>
2 36
3 * emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. 37 * emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg.
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 @@
1;;; byte-lexbind.el --- Lexical binding support for byte-compiler
2;;
3;; Copyright (C) 2001, 2002, 2010, 2011 Free Software Foundation, Inc.
4;;
5;; Author: Miles Bader <miles@gnu.org>
6;; Keywords: lisp, compiler, lexical binding
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
24
25;;; Commentary:
26;;
27
28;;; Code:
29
30(require 'bytecomp-preload "bytecomp")
31
32;; Downward closures aren't implemented yet, so this should always be nil
33(defconst byte-compile-use-downward-closures nil
34 "If true, use `downward closures', which are closures that don't cons.")
35
36(defconst byte-compile-save-window-excursion-uses-eval t
37 "If true, the bytecode for `save-window-excursion' uses eval.
38This means that the body of the form must be put into a closure.")
39
40(defun byte-compile-arglist-vars (arglist)
41 "Return a list of the variables in the lambda argument list ARGLIST."
42 (remq '&rest (remq '&optional arglist)))
43
44
45;;; Variable extent analysis.
46
47;; A `lforminfo' holds information about lexical bindings in a form, and some
48;; other info for analysis. It is a cons-cell, where the car is a list of
49;; `lvarinfo' stuctures, which form an alist indexed by variable name, and the
50;; cdr is the number of closures found in the form:
51;;
52;; LFORMINFO : ((LVARINFO ...) . NUM-CLOSURES)"
53;;
54;; A `lvarinfo' holds information about a single lexical variable. It is a
55;; list whose car is the variable name (so an lvarinfo is suitable as an alist
56;; entry), and the rest of the of which holds information about the variable:
57;;
58;; LVARINFO : (VAR NUM-REFS NUM-SETS CLOSED-OVER)
59;;
60;; NUM-REFS is the number of times the variable's value is used
61;; NUM-SETS is the number of times the variable's value is set
62;; CLOSED-OVER is non-nil if the variable is referenced
63;; anywhere but in its original function-level"
64
65;;; lvarinfo:
66
67;; constructor
68(defsubst byte-compile-make-lvarinfo (var &optional already-set)
69 (list var 0 (if already-set 1 0) 0 nil))
70;; accessors
71(defsubst byte-compile-lvarinfo-var (vinfo) (car vinfo))
72(defsubst byte-compile-lvarinfo-num-refs (vinfo) (cadr vinfo))
73(defsubst byte-compile-lvarinfo-num-sets (vinfo) (nth 3 vinfo))
74(defsubst byte-compile-lvarinfo-closed-over-p (vinfo) (nth 4 vinfo))
75;; setters
76(defsubst byte-compile-lvarinfo-note-ref (vinfo)
77 (setcar (cdr vinfo) (1+ (cadr vinfo))))
78(defsubst byte-compile-lvarinfo-note-set (vinfo)
79 (setcar (cddr vinfo) (1+ (nth 3 vinfo))))
80(defsubst byte-compile-lvarinfo-note-closure (vinfo)
81 (setcar (nthcdr 4 vinfo) t))
82
83;;; lforminfo:
84
85;; constructor
86(defsubst byte-compile-make-lforminfo ()
87 (cons nil 0))
88;; accessors
89(defalias 'byte-compile-lforminfo-vars 'car)
90(defalias 'byte-compile-lforminfo-num-closures 'cdr)
91;; setters
92(defsubst byte-compile-lforminfo-add-var (finfo var &optional already-set)
93 (setcar finfo (cons (byte-compile-make-lvarinfo var already-set)
94 (car finfo))))
95
96(defun byte-compile-lforminfo-make-closure-flag ()
97 "Return a new `closure-flag'."
98 (cons nil nil))
99
100(defsubst byte-compile-lforminfo-note-closure (lforminfo lvarinfo closure-flag)
101 "If a variable reference or definition is inside a closure, record that fact.
102LFORMINFO describes the form currently being analyzed, and LVARINFO
103describes the variable. CLOSURE-FLAG is either nil, if currently _not_
104inside a closure, and otherwise a `closure flag' returned by
105`byte-compile-lforminfo-make-closure-flag'."
106 (when closure-flag
107 (byte-compile-lvarinfo-note-closure lvarinfo)
108 (unless (car closure-flag)
109 (setcdr lforminfo (1+ (cdr lforminfo)))
110 (setcar closure-flag t))))
111
112(defun byte-compile-compute-lforminfo (form &optional special)
113 "Return information about variables lexically bound by FORM.
114SPECIAL is a list of variables that are special, and so shouldn't be
115bound lexically (in addition to variable that are considered special
116because they are declared with `defvar', et al).
117
118The result is an `lforminfo' data structure."
119 (and
120 (consp form)
121 (let ((lforminfo (byte-compile-make-lforminfo)))
122 (cond ((eq (car form) 'let)
123 ;; Find the bound variables
124 (dolist (clause (cadr form))
125 (let ((var (if (consp clause) (car clause) clause)))
126 (unless (or (special-variable-p var) (memq var special))
127 (byte-compile-lforminfo-add-var lforminfo var t))))
128 ;; Analyze the body
129 (unless (null (byte-compile-lforminfo-vars lforminfo))
130 (byte-compile-lforminfo-analyze-forms lforminfo form 2
131 special nil)))
132 ((eq (car form) 'let*)
133 (dolist (clause (cadr form))
134 (let ((var (if (consp clause) (car clause) clause)))
135 ;; Analyze each initializer based on the previously
136 ;; bound variables.
137 (when (and (consp clause) lforminfo)
138 (byte-compile-lforminfo-analyze lforminfo (cadr clause)
139 special nil))
140 (unless (or (special-variable-p var) (memq var special))
141 (byte-compile-lforminfo-add-var lforminfo var t))))
142 ;; Analyze the body
143 (unless (null (byte-compile-lforminfo-vars lforminfo))
144 (byte-compile-lforminfo-analyze-forms lforminfo form 2
145 special nil)))
146 ((eq (car form) 'condition-case)
147 ;; `condition-case' currently must dynamically bind the
148 ;; error variable, so do nothing.
149 )
150 ((memq (car form) '(defun defmacro))
151 (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special))
152 ((eq (car form) 'lambda)
153 (byte-compile-lforminfo-from-lambda lforminfo form special))
154 ((and (consp (car form)) (eq (caar form) 'lambda))
155 ;; An embedded lambda, which is basically just a `let'
156 (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special)))
157 (if (byte-compile-lforminfo-vars lforminfo)
158 lforminfo
159 nil))))
160
161(defun byte-compile-lforminfo-from-lambda (lforminfo lambda special)
162 "Initialize LFORMINFO from the lambda expression LAMBDA.
163SPECIAL is a list of variables to ignore.
164The first element of LAMBDA is ignored; it need not actually be `lambda'."
165 ;; Add the arguments
166 (dolist (arg (byte-compile-arglist-vars (cadr lambda)))
167 (byte-compile-lforminfo-add-var lforminfo arg t))
168 ;; Analyze the body
169 (unless (null (byte-compile-lforminfo-vars lforminfo))
170 (byte-compile-lforminfo-analyze-forms lforminfo lambda 2 special nil)))
171
172(defun byte-compile-lforminfo-analyze (lforminfo form &optional ignore closure-flag)
173 "Update variable information in LFORMINFO by analyzing FORM.
174IGNORE is a list of variables that shouldn't be analyzed (usually because
175they're special, or because some inner binding shadows the version in
176LFORMINFO). CLOSURE-FLAG should be either nil or a `closure flag' created
177with `byte-compile-lforminfo-make-closure-flag'; the latter indicates that
178FORM is inside a lambda expression that may close over some variable in
179LFORMINFO."
180 (cond ((symbolp form)
181 ;; variable reference
182 (unless (member form ignore)
183 (let ((vinfo (assq form (byte-compile-lforminfo-vars lforminfo))))
184 (when vinfo
185 (byte-compile-lvarinfo-note-ref vinfo)
186 (byte-compile-lforminfo-note-closure lforminfo vinfo
187 closure-flag)))))
188 ;; function call/special form
189 ((consp form)
190 (let ((fun (car form)))
191 (cond
192 ((eq fun 'setq)
193 (pop form)
194 (while form
195 (let ((var (pop form)))
196 (byte-compile-lforminfo-analyze lforminfo (pop form)
197 ignore closure-flag)
198 (unless (member var ignore)
199 (let ((vinfo
200 (assq var (byte-compile-lforminfo-vars lforminfo))))
201 (when vinfo
202 (byte-compile-lvarinfo-note-set vinfo)
203 (byte-compile-lforminfo-note-closure lforminfo vinfo
204 closure-flag)))))))
205 ((and (eq fun 'catch) (not (eq :fun-body (nth 2 form))))
206 ;; tag
207 (byte-compile-lforminfo-analyze lforminfo (cadr form)
208 ignore closure-flag)
209 ;; `catch' uses a closure for the body
210 (byte-compile-lforminfo-analyze-forms
211 lforminfo form 2
212 ignore
213 (or closure-flag
214 (and (not byte-compile-use-downward-closures)
215 (byte-compile-lforminfo-make-closure-flag)))))
216 ((eq fun 'cond)
217 (byte-compile-lforminfo-analyze-clauses lforminfo (cdr form) 0
218 ignore closure-flag))
219 ((eq fun 'condition-case)
220 ;; `condition-case' separates its body/handlers into
221 ;; separate closures.
222 (unless (or (eq (nth 1 form) :fun-body)
223 closure-flag byte-compile-use-downward-closures)
224 ;; condition case is implemented by calling a function
225 (setq closure-flag (byte-compile-lforminfo-make-closure-flag)))
226 ;; value form
227 (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
228 ignore closure-flag)
229 ;; the error variable is always bound dynamically (because
230 ;; of the implementation)
231 (when (cadr form)
232 (push (cadr form) ignore))
233 ;; handlers
234 (byte-compile-lforminfo-analyze-clauses lforminfo
235 (nthcdr 2 form) 1
236 ignore closure-flag))
237 ((eq fun '(defvar defconst))
238 (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
239 ignore closure-flag))
240 ((memq fun '(defun defmacro))
241 (byte-compile-lforminfo-analyze-forms lforminfo form 3
242 ignore closure-flag))
243 ((eq fun 'function)
244 ;; Analyze an embedded lambda expression [note: we only recognize
245 ;; it within (function ...) as the (lambda ...) for is actually a
246 ;; macro returning (function (lambda ...))].
247 (when (and (consp (cadr form)) (eq (car (cadr form)) 'lambda))
248 ;; shadow bound variables
249 (setq ignore
250 (append (byte-compile-arglist-vars (cadr (cadr form)))
251 ignore))
252 ;; analyze body of lambda
253 (byte-compile-lforminfo-analyze-forms
254 lforminfo (cadr form) 2
255 ignore
256 (or closure-flag
257 (byte-compile-lforminfo-make-closure-flag)))))
258 ((eq fun 'let)
259 ;; analyze variable inits
260 (byte-compile-lforminfo-analyze-clauses lforminfo (cadr form) 1
261 ignore closure-flag)
262 ;; shadow bound variables
263 (dolist (clause (cadr form))
264 (push (if (symbolp clause) clause (car clause))
265 ignore))
266 ;; analyze body
267 (byte-compile-lforminfo-analyze-forms lforminfo form 2
268 ignore closure-flag))
269 ((eq fun 'let*)
270 (dolist (clause (cadr form))
271 (if (symbolp clause)
272 ;; shadow bound (to nil) variable
273 (push clause ignore)
274 ;; analyze variable init
275 (byte-compile-lforminfo-analyze lforminfo (cadr clause)
276 ignore closure-flag)
277 ;; shadow bound variable
278 (push (car clause) ignore)))
279 ;; analyze body
280 (byte-compile-lforminfo-analyze-forms lforminfo form 2
281 ignore closure-flag))
282 ((eq fun 'quote)
283 ;; do nothing
284 )
285 ((and (eq fun 'save-window-excursion)
286 (not (eq :fun-body (nth 1 form))))
287 ;; `save-window-excursion' currently uses a funny implementation
288 ;; that requires its body forms be put into a closure (it should
289 ;; be fixed to work more like `save-excursion' etc., do).
290 (byte-compile-lforminfo-analyze-forms
291 lforminfo form 2
292 ignore
293 (or closure-flag
294 (and byte-compile-save-window-excursion-uses-eval
295 (not byte-compile-use-downward-closures)
296 (byte-compile-lforminfo-make-closure-flag)))))
297 ((and (consp fun) (eq (car fun) 'lambda))
298 ;; Embedded lambda. These are inlined by the compiler, so
299 ;; we don't treat them like a real closure, more like `let'.
300 ;; analyze inits
301 (byte-compile-lforminfo-analyze-forms lforminfo form 2
302 ignore closure-flag)
303
304 ;; shadow bound variables
305 (setq ignore (nconc (byte-compile-arglist-vars (cadr fun))
306 ignore))
307 ;; analyze body
308 (byte-compile-lforminfo-analyze-forms lforminfo fun 2
309 ignore closure-flag))
310 (t
311 ;; For everything else, we just expand each argument (for
312 ;; setq/setq-default this works alright because the
313 ;; variable names are symbols).
314 (byte-compile-lforminfo-analyze-forms lforminfo form 1
315 ignore closure-flag)))))))
316
317(defun byte-compile-lforminfo-analyze-forms
318 (lforminfo forms skip ignore closure-flag)
319 "Update variable information in LFORMINFO by analyzing each form in FORMS.
320The first SKIP elements of FORMS are skipped without analysis. IGNORE
321is a list of variables that shouldn't be analyzed (usually because
322they're special, or because some inner binding shadows the version in
323LFORMINFO). CLOSURE-FLAG should be either nil or a `closure flag' created with
324`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
325inside a lambda expression that may close over some variable in LFORMINFO."
326 (when skip
327 (setq forms (nthcdr skip forms)))
328 (while forms
329 (byte-compile-lforminfo-analyze lforminfo (pop forms)
330 ignore closure-flag)))
331
332(defun byte-compile-lforminfo-analyze-clauses
333 (lforminfo clauses skip ignore closure-flag)
334 "Update variable information in LFORMINFO by analyzing each clause in CLAUSES.
335Each clause is a list of forms; any clause that's not a list is ignored. The
336first SKIP elements of each clause are skipped without analysis. IGNORE is a
337list of variables that shouldn't be analyzed (usually because they're special,
338or because some inner binding shadows the version in LFORMINFO).
339CLOSURE-FLAG should be either nil or a `closure flag' created with
340`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
341inside a lambda expression that may close over some variable in LFORMINFO."
342 (while clauses
343 (let ((clause (pop clauses)))
344 (when (consp clause)
345 (byte-compile-lforminfo-analyze-forms lforminfo clause skip
346 ignore closure-flag)))))
347
348
349;;; Lexical environments
350
351;; A lexical environment is an alist, where each element is of the form
352;; (VAR . (OFFSET . ENV)) where VAR is either a symbol, for normal
353;; variables, or an `heapenv' descriptor for references to heap environment
354;; vectors. ENV is either an atom, meaning a `stack allocated' variable
355;; (the particular atom serves to indicate the particular function context
356;; on whose stack it's allocated), or an `heapenv' descriptor (see above),
357;; meaning a variable allocated in a heap environment vector. For the
358;; later case, an anonymous `variable' holding a pointer to the environment
359;; vector may be located by recursively looking up ENV in the environment
360;; as if it were a variable (so the entry for that `variable' will have a
361;; non-symbol VAR).
362
363;; We call a lexical environment a `lexenv', and an entry in it a `lexvar'.
364
365;; constructor
366(defsubst byte-compile-make-lexvar (name offset &optional env)
367 (cons name (cons offset env)))
368;; accessors
369(defsubst byte-compile-lexvar-name (lexvar) (car lexvar))
370(defsubst byte-compile-lexvar-offset (lexvar) (cadr lexvar))
371(defsubst byte-compile-lexvar-environment (lexvar) (cddr lexvar))
372(defsubst byte-compile-lexvar-variable-p (lexvar) (symbolp (car lexvar)))
373(defsubst byte-compile-lexvar-environment-p (lexvar)
374 (not (symbolp (car lexvar))))
375(defsubst byte-compile-lexvar-on-stack-p (lexvar)
376 (atom (byte-compile-lexvar-environment lexvar)))
377(defsubst byte-compile-lexvar-in-heap-p (lexvar)
378 (not (byte-compile-lexvar-on-stack-p lexvar)))
379
380(defun byte-compile-make-lambda-lexenv (form closed-over-lexenv)
381 "Return a new lexical environment for a lambda expression FORM.
382CLOSED-OVER-LEXENV is the lexical environment in which FORM occurs.
383The returned lexical environment contains two sets of variables:
384 * Variables that were in CLOSED-OVER-LEXENV and used by FORM
385 (all of these will be `heap' variables)
386 * Arguments to FORM (all of these will be `stack' variables)."
387 ;; See if this is a closure or not
388 (let ((closure nil)
389 (lforminfo (byte-compile-make-lforminfo))
390 (args (byte-compile-arglist-vars (cadr form))))
391 ;; Add variables from surrounding lexical environment to analysis set
392 (dolist (lexvar closed-over-lexenv)
393 (when (and (byte-compile-lexvar-in-heap-p lexvar)
394 (not (memq (car lexvar) args)))
395 ;; The variable is located in a heap-allocated environment
396 ;; vector, so FORM may use it. Add it to the set of variables
397 ;; that we'll search for in FORM.
398 (byte-compile-lforminfo-add-var lforminfo (car lexvar))))
399 ;; See how FORM uses these potentially closed-over variables.
400 (byte-compile-lforminfo-analyze lforminfo form args)
401 (let ((lexenv nil))
402 (dolist (vinfo (byte-compile-lforminfo-vars lforminfo))
403 (when (> (byte-compile-lvarinfo-num-refs vinfo) 0)
404 ;; FORM uses VINFO's variable, so it must be a closure.
405 (setq closure t)
406 ;; Make sure that the environment in which the variable is
407 ;; located is accessible (since we only ever pass the
408 ;; innermost environment to closures, if it's in some other
409 ;; envionment, there must be path to it from the innermost
410 ;; one).
411 (unless (byte-compile-lexvar-in-heap-p vinfo)
412 ;; To access the variable from FORM, it must be in the heap.
413 (error
414 "Compiler error: lexical variable `%s' should be heap-allocated but is not"
415 (car vinfo)))
416 (let ((closed-over-lexvar (assq (car vinfo) closed-over-lexenv)))
417 (byte-compile-heapenv-ensure-access
418 byte-compile-current-heap-environment
419 (byte-compile-lexvar-environment closed-over-lexvar))
420 ;; Put this variable in the new lexical environment
421 (push closed-over-lexvar lexenv))))
422 ;; Fill in the initial stack contents
423 (let ((stackpos 0))
424 (when closure
425 ;; Add the magic first argument that holds the environment pointer
426 (push (byte-compile-make-lexvar byte-compile-current-heap-environment
427 0)
428 lexenv)
429 (setq stackpos (1+ stackpos)))
430 ;; Add entries for each argument
431 (dolist (arg args)
432 (push (byte-compile-make-lexvar arg stackpos) lexenv)
433 (setq stackpos (1+ stackpos)))
434 ;; Return the new lexical environment
435 lexenv))))
436
437(defun byte-compile-closure-initial-lexenv-p (lexenv)
438 "Return non-nil if LEXENV is the initial lexical environment for a closure.
439This only works correctly when passed a new lexical environment as
440returned by `byte-compile-make-lambda-lexenv' (it works by checking to
441see whether there are any heap-allocated lexical variables in LEXENV)."
442 (let ((closure nil))
443 (while (and lexenv (not closure))
444 (when (byte-compile-lexvar-environment-p (pop lexenv))
445 (setq closure t)))
446 closure))
447
448
449;;; Heap environment vectors
450
451;; A `heap environment vector' is heap-allocated vector used to store
452;; variable that can't be put onto the stack.
453;;
454;; They are represented in the compiler by a list of the form
455;;
456;; (SIZE SIZE-CONST-ID INIT-POSITION . ENVS)
457;;
458;; SIZE is the current size of the vector (which may be
459;; incremented if another variable or environment-reference is added to
460;; the end). SIZE-CONST-ID is an `unknown constant id' (as returned by
461;; `byte-compile-push-unknown-constant') representing the constant used
462;; in the vector initialization code, and INIT-POSITION is a position
463;; in the byte-code output (as returned by `byte-compile-delay-out')
464;; at which more initialization code can be added.
465;; ENVS is a list of other environment vectors accessible form this one,
466;; where each element is of the form (ENV . OFFSET).
467
468;; constructor
469(defsubst byte-compile-make-heapenv (size-const-id init-position)
470 (list 0 size-const-id init-position))
471;; accessors
472(defsubst byte-compile-heapenv-size (heapenv) (car heapenv))
473(defsubst byte-compile-heapenv-size-const-id (heapenv) (cadr heapenv))
474(defsubst byte-compile-heapenv-init-position (heapenv) (nth 2 heapenv))
475(defsubst byte-compile-heapenv-accessible-envs (heapenv) (nthcdr 3 heapenv))
476
477(defun byte-compile-heapenv-add-slot (heapenv)
478 "Add a slot to the heap environment HEAPENV and return its offset."
479 (prog1 (car heapenv) (setcar heapenv (1+ (car heapenv)))))
480
481(defun byte-compile-heapenv-add-accessible-env (heapenv env offset)
482 "Add to HEAPENV's list of accessible environments, ENV at OFFSET."
483 (setcdr (nthcdr 2 heapenv)
484 (cons (cons env offset)
485 (byte-compile-heapenv-accessible-envs heapenv))))
486
487(defun byte-compile-push-heapenv ()
488 "Generate byte-code to push a new heap environment vector.
489Sets `byte-compile-current-heap-environment' to the compiler descriptor
490for the new heap environment.
491Return a `lexvar' descriptor for the new heap environment."
492 (let ((env-stack-pos byte-compile-depth)
493 size-const-id init-position)
494 ;; Generate code to push the vector
495 (byte-compile-push-constant 'make-vector)
496 (setq size-const-id (byte-compile-push-unknown-constant))
497 (byte-compile-push-constant nil)
498 (byte-compile-out 'byte-call 2)
499 (setq init-position (byte-compile-delay-out 3))
500 ;; Now make a heap-environment for the compiler to use
501 (setq byte-compile-current-heap-environment
502 (byte-compile-make-heapenv size-const-id init-position))
503 (byte-compile-make-lexvar byte-compile-current-heap-environment
504 env-stack-pos)))
505
506(defun byte-compile-heapenv-ensure-access (heapenv other-heapenv)
507 "Make sure that HEAPENV can be used to access OTHER-HEAPENV.
508If not, then add a new slot to HEAPENV pointing to OTHER-HEAPENV."
509 (unless (memq heapenv (byte-compile-heapenv-accessible-envs heapenv))
510 (let ((offset (byte-compile-heapenv-add-slot heapenv)))
511 (byte-compile-heapenv-add-accessible-env heapenv other-heapenv offset))))
512
513
514;;; Variable binding/unbinding
515
516(defun byte-compile-non-stack-bindings-p (clauses lforminfo)
517 "Return non-nil if any lexical bindings in CLAUSES are not stack-allocated.
518LFORMINFO should be information about lexical variables being bound."
519 (let ((vars (byte-compile-lforminfo-vars lforminfo)))
520 (or (not (= (length clauses) (length vars)))
521 (progn
522 (while (and vars clauses)
523 (when (byte-compile-lvarinfo-closed-over-p (pop vars))
524 (setq clauses nil)))
525 (not clauses)))))
526
527(defun byte-compile-let-clauses-trivial-init-p (clauses)
528 "Return true if let binding CLAUSES all have a `trivial' init value.
529Trivial means either a constant value, or a simple variable initialization."
530 (or (null clauses)
531 (and (or (atom (car clauses))
532 (atom (cadr (car clauses)))
533 (eq (car (cadr (car clauses))) 'quote))
534 (byte-compile-let-clauses-trivial-init-p (cdr clauses)))))
535
536(defun byte-compile-rearrange-let-clauses (clauses lforminfo)
537 "Return CLAUSES rearranged so non-stack variables come last if possible.
538Care is taken to only do so when it's clear that the meaning is the same.
539LFORMINFO should be information about lexical variables being bound."
540 ;; We currently do a very simple job by only exchanging clauses when
541 ;; one has a constant init, or one has a variable init and the other
542 ;; doesn't have a function call init (because that could change the
543 ;; value of the variable). This could be more clever and actually
544 ;; attempt to analyze which variables could possible be changed, etc.
545 (let ((unchanged nil)
546 (lex-non-stack nil)
547 (dynamic nil))
548 (while clauses
549 (let* ((clause (pop clauses))
550 (var (if (consp clause) (car clause) clause))
551 (init (and (consp clause) (cadr clause)))
552 (vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
553 (cond
554 ((or (and vinfo
555 (not (byte-compile-lvarinfo-closed-over-p vinfo)))
556 (not
557 (or (eq init nil) (eq init t)
558 (and (atom init) (not (symbolp init)))
559 (and (consp init) (eq (car init) 'quote))
560 (byte-compile-let-clauses-trivial-init-p clauses))))
561 (push clause unchanged))
562 (vinfo
563 (push clause lex-non-stack))
564 (t
565 (push clause dynamic)))))
566 (nconc (nreverse unchanged) (nreverse lex-non-stack) (nreverse dynamic))))
567
568(defun byte-compile-maybe-push-heap-environment (&optional lforminfo)
569 "Push a new heap environment if necessary.
570LFORMINFO should be information about lexical variables being bound.
571Return a lexical environment containing only the heap vector (or
572nil if nothing was pushed).
573Also, `byte-compile-current-heap-environment' and
574`byte-compile-current-num-closures' are updated to reflect any change (so they
575should probably be bound by the caller to ensure that the new values have the
576proper scope)."
577 ;; We decide whether a new heap environment is required by seeing if
578 ;; the number of closures inside the form described by LFORMINFO is
579 ;; the same as the number inside the binding form that created the
580 ;; currently active heap environment.
581 (let ((nclosures
582 (and lforminfo (byte-compile-lforminfo-num-closures lforminfo))))
583 (if (or (null lforminfo)
584 (zerop nclosures)
585 (= nclosures byte-compile-current-num-closures))
586 ;; No need to push a heap environment.
587 nil
588 (error "Should have been handled by cconv")
589 ;; Have to push one. A heap environment is really just a vector, so
590 ;; we emit bytecodes to create a vector. However, the size is not
591 ;; fixed yet (the vector can grow if subforms use it to store
592 ;; values, and if `access points' to parent heap environments are
593 ;; added), so we use `byte-compile-push-unknown-constant' to push the
594 ;; vector size.
595 (setq byte-compile-current-num-closures nclosures)
596 (list (byte-compile-push-heapenv)))))
597
598(defun byte-compile-bind (var init-lexenv &optional lforminfo)
599 "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
600INIT-LEXENV should be a lexical-environment alist describing the
601positions of the init value that have been pushed on the stack, and
602LFORMINFO should be information about lexical variables being bound.
603Return non-nil if the TOS value was popped."
604 ;; The presence of lexical bindings mean that we may have to
605 ;; juggle things on the stack, either to move them to TOS for
606 ;; dynamic binding, or to put them in a non-stack environment
607 ;; vector.
608 (let ((vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
609 (cond ((and (null vinfo) (eq var (caar init-lexenv)))
610 ;; VAR is dynamic and is on the top of the
611 ;; stack, so we can just bind it like usual
612 (byte-compile-dynamic-variable-bind var)
613 t)
614 ((null vinfo)
615 ;; VAR is dynamic, but we have to get its
616 ;; value out of the middle of the stack
617 (let ((stack-pos (cdr (assq var init-lexenv))))
618 (byte-compile-stack-ref stack-pos)
619 (byte-compile-dynamic-variable-bind var)
620 ;; Now we have to store nil into its temporary
621 ;; stack position to avoid problems with GC
622 (byte-compile-push-constant nil)
623 (byte-compile-stack-set stack-pos))
624 nil)
625 ((byte-compile-lvarinfo-closed-over-p vinfo)
626 ;; VAR is lexical, but needs to be in a
627 ;; heap-allocated environment.
628 (unless byte-compile-current-heap-environment
629 (error "No current heap-environment to allocate `%s' in!" var))
630 (let ((init-stack-pos
631 ;; nil if the init value is on the top of the stack,
632 ;; otherwise the position of the init value on the stack.
633 (and (not (eq var (caar init-lexenv)))
634 (byte-compile-lexvar-offset (assq var init-lexenv))))
635 (env-vec-pos
636 ;; Position of VAR in the environment vector
637 (byte-compile-lexvar-offset
638 (assq var byte-compile-lexical-environment)))
639 (env-vec-stack-pos
640 ;; Position of the the environment vector on the stack
641 ;; (the heap-environment must _always_ be available on
642 ;; the stack!)
643 (byte-compile-lexvar-offset
644 (assq byte-compile-current-heap-environment
645 byte-compile-lexical-environment))))
646 (unless env-vec-stack-pos
647 (error "Couldn't find location of current heap environment!"))
648 (when init-stack-pos
649 ;; VAR is not on the top of the stack, so get it
650 (byte-compile-stack-ref init-stack-pos))
651 (byte-compile-stack-ref env-vec-stack-pos)
652 ;; Store the variable into the vector
653 (byte-compile-out 'byte-vec-set env-vec-pos)
654 (when init-stack-pos
655 ;; Store nil into VAR's temporary stack
656 ;; position to avoid problems with GC
657 (byte-compile-push-constant nil)
658 (byte-compile-stack-set init-stack-pos))
659 ;; Push a record of VAR's new lexical binding
660 (push (byte-compile-make-lexvar
661 var env-vec-pos byte-compile-current-heap-environment)
662 byte-compile-lexical-environment)
663 (not init-stack-pos)))
664 (t
665 ;; VAR is a simple stack-allocated lexical variable
666 (push (assq var init-lexenv)
667 byte-compile-lexical-environment)
668 nil))))
669
670(defun byte-compile-unbind (clauses init-lexenv
671 &optional lforminfo preserve-body-value)
672 "Emit byte-codes to unbind the variables bound by CLAUSES.
673CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
674lexical-environment alist describing the positions of the init value that
675have been pushed on the stack, and LFORMINFO should be information about
676the lexical variables that were bound. If PRESERVE-BODY-VALUE is true,
677then an additional value on the top of the stack, above any lexical binding
678slots, is preserved, so it will be on the top of the stack after all
679binding slots have been popped."
680 ;; Unbind dynamic variables
681 (let ((num-dynamic-bindings 0))
682 (if lforminfo
683 (dolist (clause clauses)
684 (unless (assq (if (consp clause) (car clause) clause)
685 (byte-compile-lforminfo-vars lforminfo))
686 (setq num-dynamic-bindings (1+ num-dynamic-bindings))))
687 (setq num-dynamic-bindings (length clauses)))
688 (unless (zerop num-dynamic-bindings)
689 (byte-compile-out 'byte-unbind num-dynamic-bindings)))
690 ;; Pop lexical variables off the stack, possibly preserving the
691 ;; return value of the body.
692 (when init-lexenv
693 ;; INIT-LEXENV contains all init values left on the stack
694 (byte-compile-discard (length init-lexenv) preserve-body-value)))
695
696
697(provide 'byte-lexbind)
698
699;;; 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 @@
1483 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate 1483 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
1484 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax 1484 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
1485 byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt 1485 byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
1486 byte-member byte-assq byte-quo byte-rem byte-vec-ref) 1486 byte-member byte-assq byte-quo byte-rem)
1487 byte-compile-side-effect-and-error-free-ops)) 1487 byte-compile-side-effect-and-error-free-ops))
1488 1488
1489;; This crock is because of the way DEFVAR_BOOL variables work. 1489;; 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."
1671 ;; 1671 ;;
1672 ((and (eq 'byte-dup (car lap0)) 1672 ((and (eq 'byte-dup (car lap0))
1673 (eq 'byte-discard (car lap2)) 1673 (eq 'byte-discard (car lap2))
1674 (memq (car lap1) '(byte-varset byte-varbind byte-stack-set byte-vec-set))) 1674 (memq (car lap1) '(byte-varset byte-varbind byte-stack-set)))
1675 (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) 1675 (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
1676 (setq keep-going t 1676 (setq keep-going t
1677 rest (cdr rest) 1677 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 @@
126 ;; This really ought to be loaded already! 126 ;; This really ought to be loaded already!
127 (load "byte-run")) 127 (load "byte-run"))
128 128
129;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation
130;; errors; however that file also wants to do (require 'bytecomp) for the
131;; same reason. Since we know it's OK to load byte-lexbind.el second, we
132;; have that file require a feature that's provided before at the beginning
133;; of this file, to avoid an infinite require loop.
134;; `eval-when-compile' is defined in byte-run.el, so it must come after the
135;; preceding load expression.
136(provide 'bytecomp-preload)
137(eval-when-compile (require 'byte-lexbind nil 'noerror))
138
139;; The feature of compiling in a specific target Emacs version 129;; The feature of compiling in a specific target Emacs version
140;; has been turned off because compile time options are a bad idea. 130;; has been turned off because compile time options are a bad idea.
141(defmacro byte-compile-single-version () nil) 131(defmacro byte-compile-single-version () nil)
142(defmacro byte-compile-version-cond (cond) cond) 132(defmacro byte-compile-version-cond (cond) cond)
143 133
144;; The crud you see scattered through this file of the form
145;; (or (and (boundp 'epoch::version) epoch::version)
146;; (string-lessp emacs-version "19"))
147;; is because the Epoch folks couldn't be bothered to follow the
148;; normal emacs version numbering convention.
149
150;; (if (byte-compile-version-cond
151;; (or (and (boundp 'epoch::version) epoch::version)
152;; (string-lessp emacs-version "19")))
153;; (progn
154;; ;; emacs-18 compatibility.
155;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
156;;
157;; (if (byte-compile-single-version)
158;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
159;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
160;;
161;; (or (and (fboundp 'member)
162;; ;; avoid using someone else's possibly bogus definition of this.
163;; (subrp (symbol-function 'member)))
164;; (defun member (elt list)
165;; "like memq, but uses equal instead of eq. In v19, this is a subr."
166;; (while (and list (not (equal elt (car list))))
167;; (setq list (cdr list)))
168;; list))))
169
170 134
171(defgroup bytecomp nil 135(defgroup bytecomp nil
172 "Emacs Lisp byte-compiler." 136 "Emacs Lisp byte-compiler."
@@ -439,24 +403,15 @@ specify different fields to sort on."
439 :type '(choice (const name) (const callers) (const calls) 403 :type '(choice (const name) (const callers) (const calls)
440 (const calls+callers) (const nil))) 404 (const calls+callers) (const nil)))
441 405
442;(defvar byte-compile-debug nil)
443(defvar byte-compile-debug t) 406(defvar byte-compile-debug t)
444(setq debug-on-error t) 407(setq debug-on-error t)
445 408
446;; (defvar byte-compile-overwrite-file t
447;; "If nil, old .elc files are deleted before the new is saved, and .elc
448;; files will have the same modes as the corresponding .el file. Otherwise,
449;; existing .elc files will simply be overwritten, and the existing modes
450;; will not be changed. If this variable is nil, then an .elc file which
451;; is a symbolic link will be turned into a normal file, instead of the file
452;; which the link points to being overwritten.")
453
454(defvar byte-compile-constants nil 409(defvar byte-compile-constants nil
455 "List of all constants encountered during compilation of this form.") 410 "List of all constants encountered during compilation of this form.")
456(defvar byte-compile-variables nil 411(defvar byte-compile-variables nil
457 "List of all variables encountered during compilation of this form.") 412 "List of all variables encountered during compilation of this form.")
458(defvar byte-compile-bound-variables nil 413(defvar byte-compile-bound-variables nil
459 "List of variables bound in the context of the current form. 414 "List of dynamic variables bound in the context of the current form.
460This list lives partly on the stack.") 415This list lives partly on the stack.")
461(defvar byte-compile-const-variables nil 416(defvar byte-compile-const-variables nil
462 "List of variables declared as constants during compilation of this file.") 417 "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.")
512;; Variables for lexical binding 467;; Variables for lexical binding
513(defvar byte-compile-lexical-environment nil 468(defvar byte-compile-lexical-environment nil
514 "The current lexical environment.") 469 "The current lexical environment.")
515(defvar byte-compile-current-heap-environment nil
516 "If non-nil, a descriptor for the current heap-allocated lexical environment.")
517(defvar byte-compile-current-num-closures 0
518 "The number of lexical closures that close over `byte-compile-current-heap-environment'.")
519 470
520(defvar byte-compile-tag-number 0) 471(defvar byte-compile-tag-number 0)
521(defvar byte-compile-output nil 472(defvar byte-compile-output nil
@@ -734,8 +685,6 @@ otherwise pop it")
734 685
735(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte 686(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte
736(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes 687(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes
737(byte-defop 180 1 byte-vec-ref) ; vector offset in following one byte
738(byte-defop 181 -1 byte-vec-set) ; vector offset in following one byte
739 688
740;; if (following one byte & 0x80) == 0 689;; if (following one byte & 0x80) == 0
741;; discard (following one byte & 0x7F) stack entries 690;; discard (following one byte & 0x7F) stack entries
@@ -824,68 +773,71 @@ CONST2 may be evaulated multiple times."
824 (dolist (lap-entry lap) 773 (dolist (lap-entry lap)
825 (setq op (car lap-entry) 774 (setq op (car lap-entry)
826 off (cdr lap-entry)) 775 off (cdr lap-entry))
827 (cond ((not (symbolp op)) 776 (cond
828 (error "Non-symbolic opcode `%s'" op)) 777 ((not (symbolp op))
829 ((eq op 'TAG) 778 (error "Non-symbolic opcode `%s'" op))
830 (setcar off pc)) 779 ((eq op 'TAG)
831 ((null op) 780 (setcar off pc))
832 ;; a no-op added by `byte-compile-delay-out' 781 ((null op)
833 (unless (zerop off) 782 ;; a no-op added by `byte-compile-delay-out'
834 (error 783 (unless (zerop off)
835 "Placeholder added by `byte-compile-delay-out' not filled in.") 784 (error
836 )) 785 "Placeholder added by `byte-compile-delay-out' not filled in.")
837 (t 786 ))
838 (if (eq op 'byte-discardN-preserve-tos) 787 (t
839 ;; byte-discardN-preserve-tos is a psuedo op, which is actually 788 (setq opcode
840 ;; the same as byte-discardN with a modified argument 789 (if (eq op 'byte-discardN-preserve-tos)
841 (setq opcode byte-discardN) 790 ;; byte-discardN-preserve-tos is a pseudo op, which
842 (setq opcode (symbol-value op))) 791 ;; is actually the same as byte-discardN
843 (cond ((memq op byte-goto-ops) 792 ;; with a modified argument.
844 ;; goto 793 byte-discardN
845 (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) 794 (symbol-value op)))
846 (push bytes patchlist)) 795 (cond ((memq op byte-goto-ops)
847 ((and (consp off) 796 ;; goto
848 ;; Variable or constant reference 797 (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
849 (progn (setq off (cdr off)) 798 (push bytes patchlist))
850 (eq op 'byte-constant))) 799 ((and (consp off)
851 ;; constant ref 800 ;; Variable or constant reference
852 (if (< off byte-constant-limit) 801 (progn (setq off (cdr off))
853 (byte-compile-push-bytecodes (+ byte-constant off) 802 (eq op 'byte-constant)))
854 bytes pc) 803 ;; constant ref
855 (byte-compile-push-bytecode-const2 byte-constant2 off 804 (if (< off byte-constant-limit)
856 bytes pc))) 805 (byte-compile-push-bytecodes (+ byte-constant off)
857 ((and (= opcode byte-stack-set) 806 bytes pc)
858 (> off 255)) 807 (byte-compile-push-bytecode-const2 byte-constant2 off
859 ;; Use the two-byte version of byte-stack-set if the 808 bytes pc)))
860 ;; offset is too large for the normal version. 809 ((and (= opcode byte-stack-set)
861 (byte-compile-push-bytecode-const2 byte-stack-set2 off 810 (> off 255))
862 bytes pc)) 811 ;; Use the two-byte version of byte-stack-set if the
863 ((and (>= opcode byte-listN) 812 ;; offset is too large for the normal version.
864 (< opcode byte-discardN)) 813 (byte-compile-push-bytecode-const2 byte-stack-set2 off
865 ;; These insns all put their operand into one extra byte. 814 bytes pc))
866 (byte-compile-push-bytecodes opcode off bytes pc)) 815 ((and (>= opcode byte-listN)
867 ((= opcode byte-discardN) 816 (< opcode byte-discardN))
868 ;; byte-discardN is wierd in that it encodes a flag in the 817 ;; These insns all put their operand into one extra byte.
869 ;; top bit of its one-byte argument. If the argument is 818 (byte-compile-push-bytecodes opcode off bytes pc))
870 ;; too large to fit in 7 bits, the opcode can be repeated. 819 ((= opcode byte-discardN)
871 (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0))) 820 ;; byte-discardN is wierd in that it encodes a flag in the
872 (while (> off #x7f) 821 ;; top bit of its one-byte argument. If the argument is
873 (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc) 822 ;; too large to fit in 7 bits, the opcode can be repeated.
874 (setq off (- off #x7f))) 823 (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
875 (byte-compile-push-bytecodes opcode (logior off flag) bytes pc))) 824 (while (> off #x7f)
876 ((null off) 825 (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc)
877 ;; opcode that doesn't use OFF 826 (setq off (- off #x7f)))
878 (byte-compile-push-bytecodes opcode bytes pc)) 827 (byte-compile-push-bytecodes opcode (logior off flag) bytes pc)))
879 ;; The following three cases are for the special 828 ((null off)
880 ;; insns that encode their operand into 0, 1, or 2 829 ;; opcode that doesn't use OFF
881 ;; extra bytes depending on its magnitude. 830 (byte-compile-push-bytecodes opcode bytes pc))
882 ((< off 6) 831 ;; The following three cases are for the special
883 (byte-compile-push-bytecodes (+ opcode off) bytes pc)) 832 ;; insns that encode their operand into 0, 1, or 2
884 ((< off 256) 833 ;; extra bytes depending on its magnitude.
885 (byte-compile-push-bytecodes (+ opcode 6) off bytes pc)) 834 ((< off 6)
886 (t 835 (byte-compile-push-bytecodes (+ opcode off) bytes pc))
887 (byte-compile-push-bytecode-const2 (+ opcode 7) off 836 ((< off 256)
888 bytes pc)))))) 837 (byte-compile-push-bytecodes (+ opcode 6) off bytes pc))
838 (t
839 (byte-compile-push-bytecode-const2 (+ opcode 7) off
840 bytes pc))))))
889 ;;(if (not (= pc (length bytes))) 841 ;;(if (not (= pc (length bytes)))
890 ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) 842 ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
891 843
@@ -1694,7 +1646,7 @@ that already has a `.elc' file."
1694 "Non-nil to prevent byte-compiling of Emacs Lisp code. 1646 "Non-nil to prevent byte-compiling of Emacs Lisp code.
1695This is normally set in local file variables at the end of the elisp file: 1647This is normally set in local file variables at the end of the elisp file:
1696 1648
1697;; Local Variables:\n;; no-byte-compile: t\n;; End: ") 1649\;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;Backslash for compile-main.
1698;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) 1650;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
1699 1651
1700(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load) 1652(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."
2682 (setq list (cdr list))))) 2634 (setq list (cdr list)))))
2683 2635
2684 2636
2685(autoload 'byte-compile-make-lambda-lexenv "byte-lexbind") 2637(defun byte-compile-arglist-vars (arglist)
2638 "Return a list of the variables in the lambda argument list ARGLIST."
2639 (remq '&rest (remq '&optional arglist)))
2640
2641(defun byte-compile-make-lambda-lexenv (form)
2642 "Return a new lexical environment for a lambda expression FORM."
2643 ;; See if this is a closure or not
2644 (let ((args (byte-compile-arglist-vars (cadr form))))
2645 (let ((lexenv nil))
2646 ;; Fill in the initial stack contents
2647 (let ((stackpos 0))
2648 ;; Add entries for each argument
2649 (dolist (arg args)
2650 (push (cons arg stackpos) lexenv)
2651 (setq stackpos (1+ stackpos)))
2652 ;; Return the new lexical environment
2653 lexenv))))
2686 2654
2687;; Byte-compile a lambda-expression and return a valid function. 2655;; Byte-compile a lambda-expression and return a valid function.
2688;; The value is usually a compiled function but may be the original 2656;; 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."
2700 (byte-compile-check-lambda-list (nth 1 bytecomp-fun)) 2668 (byte-compile-check-lambda-list (nth 1 bytecomp-fun))
2701 (let* ((bytecomp-arglist (nth 1 bytecomp-fun)) 2669 (let* ((bytecomp-arglist (nth 1 bytecomp-fun))
2702 (byte-compile-bound-variables 2670 (byte-compile-bound-variables
2703 (nconc (and (byte-compile-warning-enabled-p 'free-vars) 2671 (append (and (not lexical-binding)
2704 (delq '&rest 2672 (byte-compile-arglist-vars bytecomp-arglist))
2705 (delq '&optional (copy-sequence bytecomp-arglist)))) 2673 byte-compile-bound-variables))
2706 byte-compile-bound-variables))
2707 (bytecomp-body (cdr (cdr bytecomp-fun))) 2674 (bytecomp-body (cdr (cdr bytecomp-fun)))
2708 (bytecomp-doc (if (stringp (car bytecomp-body)) 2675 (bytecomp-doc (if (stringp (car bytecomp-body))
2709 (prog1 (car bytecomp-body) 2676 (prog1 (car bytecomp-body)
@@ -2742,42 +2709,27 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2742 ;; Process the body. 2709 ;; Process the body.
2743 (let* ((byte-compile-lexical-environment 2710 (let* ((byte-compile-lexical-environment
2744 ;; If doing lexical binding, push a new lexical environment 2711 ;; If doing lexical binding, push a new lexical environment
2745 ;; containing the args and any closed-over variables. 2712 ;; containing just the args (since lambda expressions
2746 (and lexical-binding 2713 ;; should be closed by now).
2747 (byte-compile-make-lambda-lexenv
2748 bytecomp-fun
2749 byte-compile-lexical-environment)))
2750 (is-closure
2751 ;; This is true if we should be making a closure instead of
2752 ;; a simple lambda (because some variables from the
2753 ;; containing lexical environment are closed over).
2754 (and lexical-binding 2714 (and lexical-binding
2755 (byte-compile-closure-initial-lexenv-p 2715 (byte-compile-make-lambda-lexenv bytecomp-fun)))
2756 byte-compile-lexical-environment)
2757 (error "Should have been handled by cconv")))
2758 (byte-compile-current-heap-environment nil)
2759 (byte-compile-current-num-closures 0)
2760 (compiled 2716 (compiled
2761 (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda))) 2717 (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
2762 ;; Build the actual byte-coded function. 2718 ;; Build the actual byte-coded function.
2763 (if (eq 'byte-code (car-safe compiled)) 2719 (if (eq 'byte-code (car-safe compiled))
2764 (let ((code 2720 (apply 'make-byte-code
2765 (apply 'make-byte-code 2721 (append (list bytecomp-arglist)
2766 (append (list bytecomp-arglist) 2722 ;; byte-string, constants-vector, stack depth
2767 ;; byte-string, constants-vector, stack depth 2723 (cdr compiled)
2768 (cdr compiled) 2724 ;; optionally, the doc string.
2769 ;; optionally, the doc string. 2725 (if (or bytecomp-doc bytecomp-int
2770 (if (or bytecomp-doc bytecomp-int 2726 lexical-binding)
2771 lexical-binding) 2727 (list bytecomp-doc))
2772 (list bytecomp-doc)) 2728 ;; optionally, the interactive spec.
2773 ;; optionally, the interactive spec. 2729 (if (or bytecomp-int lexical-binding)
2774 (if (or bytecomp-int lexical-binding) 2730 (list (nth 1 bytecomp-int)))
2775 (list (nth 1 bytecomp-int))) 2731 (if lexical-binding
2776 (if lexical-binding 2732 '(t))))
2777 '(t))))))
2778 (if is-closure
2779 (cons 'closure code)
2780 code))
2781 (setq compiled 2733 (setq compiled
2782 (nconc (if bytecomp-int (list bytecomp-int)) 2734 (nconc (if bytecomp-int (list bytecomp-int))
2783 (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) 2735 (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."
2788 (bytecomp-body (list nil)))) 2740 (bytecomp-body (list nil))))
2789 compiled)))))) 2741 compiled))))))
2790 2742
2791(defun byte-compile-closure-code-p (code)
2792 (eq (car-safe code) 'closure))
2793
2794(defun byte-compile-make-closure (code)
2795 (error "Should have been handled by cconv")
2796 ;; A real closure requires that the constant be curried with an
2797 ;; environment vector to make a closure object.
2798 (if for-effect
2799 (setq for-effect nil)
2800 (byte-compile-push-constant 'curry)
2801 (byte-compile-push-constant code)
2802 (byte-compile-lexical-variable-ref byte-compile-current-heap-environment)
2803 (byte-compile-out 'byte-call 2)))
2804
2805(defun byte-compile-closure (form &optional add-lambda) 2743(defun byte-compile-closure (form &optional add-lambda)
2806 (let ((code (byte-compile-lambda form add-lambda))) 2744 (let ((code (byte-compile-lambda form add-lambda)))
2807 (if (byte-compile-closure-code-p code) 2745 ;; A simple lambda is just a constant.
2808 (byte-compile-make-closure code) 2746 (byte-compile-constant code)))
2809 ;; A simple lambda is just a constant.
2810 (byte-compile-constant code))))
2811 2747
2812(defun byte-compile-constants-vector () 2748(defun byte-compile-constants-vector ()
2813 ;; Builds the constants-vector from the current variables and constants. 2749 ;; 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."
2867 ;; See how many arguments there are, and set the current stack depth 2803 ;; See how many arguments there are, and set the current stack depth
2868 ;; accordingly 2804 ;; accordingly
2869 (dolist (var byte-compile-lexical-environment) 2805 (dolist (var byte-compile-lexical-environment)
2870 (when (byte-compile-lexvar-on-stack-p var) 2806 (setq byte-compile-depth (1+ byte-compile-depth)))
2871 (setq byte-compile-depth (1+ byte-compile-depth))))
2872 ;; If there are args, output a tag to record the initial 2807 ;; If there are args, output a tag to record the initial
2873 ;; stack-depth for the optimizer 2808 ;; stack-depth for the optimizer
2874 (when (> byte-compile-depth 0) 2809 (when (> byte-compile-depth 0)
2875 (byte-compile-out-tag (byte-compile-make-tag))) 2810 (byte-compile-out-tag (byte-compile-make-tag))))
2876 ;; If this is the top-level of a lexically bound lambda expression,
2877 ;; perhaps some parameters on stack need to be copied into a heap
2878 ;; environment, so check for them, and do so if necessary.
2879 (let ((lforminfo (byte-compile-make-lforminfo)))
2880 ;; Add any lexical variable that's on the stack to the analysis set.
2881 (dolist (var byte-compile-lexical-environment)
2882 (when (byte-compile-lexvar-on-stack-p var)
2883 (byte-compile-lforminfo-add-var lforminfo (car var) t)))
2884 ;; Analyze the body
2885 (unless (null (byte-compile-lforminfo-vars lforminfo))
2886 (byte-compile-lforminfo-analyze lforminfo form nil nil))
2887 ;; If the analysis revealed some argument need to be in a heap
2888 ;; environment (because they're closed over by an embedded
2889 ;; lambda), put them there.
2890 (setq byte-compile-lexical-environment
2891 (nconc (byte-compile-maybe-push-heap-environment lforminfo)
2892 byte-compile-lexical-environment))
2893 (dolist (arginfo (byte-compile-lforminfo-vars lforminfo))
2894 (when (byte-compile-lvarinfo-closed-over-p arginfo)
2895 (byte-compile-bind (car arginfo)
2896 byte-compile-lexical-environment
2897 lforminfo)))))
2898 ;; Now compile FORM 2811 ;; Now compile FORM
2899 (byte-compile-form form for-effect) 2812 (byte-compile-form form for-effect)
2900 (byte-compile-out-toplevel for-effect output-type)))) 2813 (byte-compile-out-toplevel for-effect output-type))))
@@ -3044,7 +2957,7 @@ That command is designed for interactive use only" bytecomp-fn))
3044 (if (memq bytecomp-fn 2957 (if (memq bytecomp-fn
3045 '(custom-declare-group custom-declare-variable 2958 '(custom-declare-group custom-declare-variable
3046 custom-declare-face)) 2959 custom-declare-face))
3047 (byte-compile-nogroup-warn form)) 2960 (byte-compile-nogroup-warn form))
3048 (byte-compile-callargs-warn form)) 2961 (byte-compile-callargs-warn form))
3049 (if (and bytecomp-handler 2962 (if (and bytecomp-handler
3050 ;; Make sure that function exists. This is important 2963 ;; Make sure that function exists. This is important
@@ -3107,40 +3020,16 @@ If BINDING is non-nil, VAR is being bound."
3107(defun byte-compile-dynamic-variable-bind (var) 3020(defun byte-compile-dynamic-variable-bind (var)
3108 "Generate code to bind the lexical variable VAR to the top-of-stack value." 3021 "Generate code to bind the lexical variable VAR to the top-of-stack value."
3109 (byte-compile-check-variable var t) 3022 (byte-compile-check-variable var t)
3110 (when (byte-compile-warning-enabled-p 'free-vars) 3023 (push var byte-compile-bound-variables)
3111 (push var byte-compile-bound-variables))
3112 (byte-compile-dynamic-variable-op 'byte-varbind var)) 3024 (byte-compile-dynamic-variable-op 'byte-varbind var))
3113 3025
3114;; This is used when it's know that VAR _definitely_ has a lexical
3115;; binding, and no error-checking should be done.
3116(defun byte-compile-lexical-variable-ref (var)
3117 "Generate code to push the value of the lexical variable VAR on the stack."
3118 (let ((binding (assq var byte-compile-lexical-environment)))
3119 (when (null binding)
3120 (error "Lexical binding not found for `%s'" var))
3121 (if (byte-compile-lexvar-on-stack-p binding)
3122 ;; On the stack
3123 (byte-compile-stack-ref (byte-compile-lexvar-offset binding))
3124 ;; In a heap environment vector; first push the vector on the stack
3125 (byte-compile-lexical-variable-ref
3126 (byte-compile-lexvar-environment binding))
3127 ;; Now get the value from it
3128 (byte-compile-out 'byte-vec-ref (byte-compile-lexvar-offset binding)))))
3129
3130(defun byte-compile-variable-ref (var) 3026(defun byte-compile-variable-ref (var)
3131 "Generate code to push the value of the variable VAR on the stack." 3027 "Generate code to push the value of the variable VAR on the stack."
3132 (byte-compile-check-variable var) 3028 (byte-compile-check-variable var)
3133 (let ((lex-binding (assq var byte-compile-lexical-environment))) 3029 (let ((lex-binding (assq var byte-compile-lexical-environment)))
3134 (if lex-binding 3030 (if lex-binding
3135 ;; VAR is lexically bound 3031 ;; VAR is lexically bound
3136 (if (byte-compile-lexvar-on-stack-p lex-binding) 3032 (byte-compile-stack-ref (cdr lex-binding))
3137 ;; On the stack
3138 (byte-compile-stack-ref (byte-compile-lexvar-offset lex-binding))
3139 ;; In a heap environment vector
3140 (byte-compile-lexical-variable-ref
3141 (byte-compile-lexvar-environment lex-binding))
3142 (byte-compile-out 'byte-vec-ref
3143 (byte-compile-lexvar-offset lex-binding)))
3144 ;; VAR is dynamically bound 3033 ;; VAR is dynamically bound
3145 (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) 3034 (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
3146 (boundp var) 3035 (boundp var)
@@ -3156,14 +3045,7 @@ If BINDING is non-nil, VAR is being bound."
3156 (let ((lex-binding (assq var byte-compile-lexical-environment))) 3045 (let ((lex-binding (assq var byte-compile-lexical-environment)))
3157 (if lex-binding 3046 (if lex-binding
3158 ;; VAR is lexically bound 3047 ;; VAR is lexically bound
3159 (if (byte-compile-lexvar-on-stack-p lex-binding) 3048 (byte-compile-stack-set (cdr lex-binding))
3160 ;; On the stack
3161 (byte-compile-stack-set (byte-compile-lexvar-offset lex-binding))
3162 ;; In a heap environment vector
3163 (byte-compile-lexical-variable-ref
3164 (byte-compile-lexvar-environment lex-binding))
3165 (byte-compile-out 'byte-vec-set
3166 (byte-compile-lexvar-offset lex-binding)))
3167 ;; VAR is dynamically bound 3049 ;; VAR is dynamically bound
3168 (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) 3050 (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
3169 (boundp var) 3051 (boundp var)
@@ -3795,9 +3677,7 @@ that suppresses all warnings during execution of BODY."
3795 ,condition (list 'boundp 'default-boundp))) 3677 ,condition (list 'boundp 'default-boundp)))
3796 ;; Maybe add to the bound list. 3678 ;; Maybe add to the bound list.
3797 (byte-compile-bound-variables 3679 (byte-compile-bound-variables
3798 (if bound-list 3680 (append bound-list byte-compile-bound-variables)))
3799 (append bound-list byte-compile-bound-variables)
3800 byte-compile-bound-variables)))
3801 (unwind-protect 3681 (unwind-protect
3802 ;; If things not being bound at all is ok, so must them being obsolete. 3682 ;; If things not being bound at all is ok, so must them being obsolete.
3803 ;; Note that we add to the existing lists since Tramp (ab)uses 3683 ;; Note that we add to the existing lists since Tramp (ab)uses
@@ -3910,14 +3790,7 @@ that suppresses all warnings during execution of BODY."
3910 3790
3911(defun byte-compile-while (form) 3791(defun byte-compile-while (form)
3912 (let ((endtag (byte-compile-make-tag)) 3792 (let ((endtag (byte-compile-make-tag))
3913 (looptag (byte-compile-make-tag)) 3793 (looptag (byte-compile-make-tag)))
3914 ;; Heap environments can't be shared between a loop and its
3915 ;; enclosing environment (because any lexical variables bound
3916 ;; inside the loop should have an independent value for each
3917 ;; iteration). Setting `byte-compile-current-num-closures' to
3918 ;; an invalid value causes the code that tries to merge
3919 ;; environments to not do so.
3920 (byte-compile-current-num-closures -1))
3921 (byte-compile-out-tag looptag) 3794 (byte-compile-out-tag looptag)
3922 (byte-compile-form (car (cdr form))) 3795 (byte-compile-form (car (cdr form)))
3923 (byte-compile-goto-if nil for-effect endtag) 3796 (byte-compile-goto-if nil for-effect endtag)
@@ -3933,109 +3806,131 @@ that suppresses all warnings during execution of BODY."
3933 3806
3934;; let binding 3807;; let binding
3935 3808
3936;; All other lexical-binding functions are guarded by a non-nil return 3809(defun byte-compile-push-binding-init (clause)
3937;; value from `byte-compile-compute-lforminfo', so they needn't be
3938;; autoloaded.
3939(autoload 'byte-compile-compute-lforminfo "byte-lexbind")
3940
3941(defun byte-compile-push-binding-init (clause init-lexenv lforminfo)
3942 "Emit byte-codes to push the initialization value for CLAUSE on the stack. 3810 "Emit byte-codes to push the initialization value for CLAUSE on the stack.
3943INIT-LEXENV is the lexical environment created for initializations 3811Return the offset in the form (VAR . OFFSET)."
3944already done for this form. 3812 (let* ((var (if (consp clause) (car clause) clause)))
3945LFORMINFO should be information about lexical variables being bound. 3813 ;; We record the stack position even of dynamic bindings and
3946Return INIT-LEXENV updated to include the newest initialization, or nil 3814 ;; variables in non-stack lexical environments; we'll put
3947if LFORMINFO is nil (meaning all bindings are dynamic)." 3815 ;; them in the proper place below.
3948 (let* ((var (if (consp clause) (car clause) clause)) 3816 (prog1 (cons var byte-compile-depth)
3949 (vinfo
3950 (and lforminfo (assq var (byte-compile-lforminfo-vars lforminfo))))
3951 (unused (and vinfo (zerop (cadr vinfo)))))
3952 (unless (and unused (symbolp clause))
3953 (when (and lforminfo (not unused))
3954 ;; We record the stack position even of dynamic bindings and
3955 ;; variables in non-stack lexical environments; we'll put
3956 ;; them in the proper place below.
3957 (push (byte-compile-make-lexvar var byte-compile-depth) init-lexenv))
3958 (if (consp clause) 3817 (if (consp clause)
3959 (byte-compile-form (cadr clause) unused) 3818 (byte-compile-form (cadr clause))
3960 (byte-compile-push-constant nil)))) 3819 (byte-compile-push-constant nil)))))
3961 init-lexenv) 3820
3821(defun byte-compile-not-lexical-var-p (var)
3822 (or (not (symbolp var)) ; form is not a list
3823 (if (eval-when-compile (fboundp 'special-variable-p))
3824 (special-variable-p var)
3825 (boundp var))
3826 (memq var byte-compile-bound-variables)
3827 (memq var '(nil t))
3828 (keywordp var)))
3829
3830(defun byte-compile-bind (var init-lexenv)
3831 "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
3832INIT-LEXENV should be a lexical-environment alist describing the
3833positions of the init value that have been pushed on the stack.
3834Return non-nil if the TOS value was popped."
3835 ;; The presence of lexical bindings mean that we may have to
3836 ;; juggle things on the stack, either to move them to TOS for
3837 ;; dynamic binding, or to put them in a non-stack environment
3838 ;; vector.
3839 (cond ((not (byte-compile-not-lexical-var-p var))
3840 ;; VAR is a simple stack-allocated lexical variable
3841 (push (assq var init-lexenv)
3842 byte-compile-lexical-environment)
3843 nil)
3844 ((eq var (caar init-lexenv))
3845 ;; VAR is dynamic and is on the top of the
3846 ;; stack, so we can just bind it like usual
3847 (byte-compile-dynamic-variable-bind var)
3848 t)
3849 (t
3850 ;; VAR is dynamic, but we have to get its
3851 ;; value out of the middle of the stack
3852 (let ((stack-pos (cdr (assq var init-lexenv))))
3853 (byte-compile-stack-ref stack-pos)
3854 (byte-compile-dynamic-variable-bind var)
3855 ;; Now we have to store nil into its temporary
3856 ;; stack position to avoid problems with GC
3857 (byte-compile-push-constant nil)
3858 (byte-compile-stack-set stack-pos))
3859 nil)))
3860
3861(defun byte-compile-unbind (clauses init-lexenv
3862 &optional preserve-body-value)
3863 "Emit byte-codes to unbind the variables bound by CLAUSES.
3864CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
3865lexical-environment alist describing the positions of the init value that
3866have been pushed on the stack. If PRESERVE-BODY-VALUE is true,
3867then an additional value on the top of the stack, above any lexical binding
3868slots, is preserved, so it will be on the top of the stack after all
3869binding slots have been popped."
3870 ;; Unbind dynamic variables
3871 (let ((num-dynamic-bindings 0))
3872 (dolist (clause clauses)
3873 (unless (assq (if (consp clause) (car clause) clause)
3874 byte-compile-lexical-environment)
3875 (setq num-dynamic-bindings (1+ num-dynamic-bindings))))
3876 (unless (zerop num-dynamic-bindings)
3877 (byte-compile-out 'byte-unbind num-dynamic-bindings)))
3878 ;; Pop lexical variables off the stack, possibly preserving the
3879 ;; return value of the body.
3880 (when init-lexenv
3881 ;; INIT-LEXENV contains all init values left on the stack
3882 (byte-compile-discard (length init-lexenv) preserve-body-value)))
3962 3883
3963(defun byte-compile-let (form) 3884(defun byte-compile-let (form)
3964 "Generate code for the `let' form FORM." 3885 "Generate code for the `let' form FORM."
3965 (let ((clauses (cadr form)) 3886 ;; First compute the binding values in the old scope.
3966 (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form))) 3887 (let ((varlist (car (cdr form)))
3967 (init-lexenv nil) 3888 (init-lexenv nil))
3968 ;; bind these to restrict the scope of any changes 3889 (dolist (var varlist)
3969 (byte-compile-current-heap-environment 3890 (push (byte-compile-push-binding-init var) init-lexenv))
3970 byte-compile-current-heap-environment) 3891 ;; Now do the bindings, execute the body, and undo the bindings.
3971 (byte-compile-current-num-closures byte-compile-current-num-closures)) 3892 (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
3972 (when (and lforminfo (byte-compile-non-stack-bindings-p clauses lforminfo)) 3893 (varlist (reverse (car (cdr form))))
3973 ;; Some of the variables we're binding are lexical variables on 3894 (byte-compile-lexical-environment byte-compile-lexical-environment))
3974 ;; the stack, but not all. As much as we can, rearrange the list 3895 (dolist (var varlist)
3975 ;; so that non-stack lexical variables and dynamically bound 3896 (let ((var (if (consp var) (car var) var)))
3976 ;; variables come last, which allows slightly more optimal 3897 (cond ((null lexical-binding)
3977 ;; byte-code for binding them.
3978 (setq clauses (byte-compile-rearrange-let-clauses clauses lforminfo)))
3979 ;; If necessary, create a new heap environment to hold some of the
3980 ;; variables bound here.
3981 (when lforminfo
3982 (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
3983 ;; First compute the binding values in the old scope.
3984 (dolist (clause clauses)
3985 (setq init-lexenv
3986 (byte-compile-push-binding-init clause init-lexenv lforminfo)))
3987 ;; Now do the bindings, execute the body, and undo the bindings
3988 (let ((byte-compile-bound-variables byte-compile-bound-variables)
3989 (byte-compile-lexical-environment byte-compile-lexical-environment)
3990 (preserve-body-value (not for-effect)))
3991 (dolist (clause (reverse clauses))
3992 (let ((var (if (consp clause) (car clause) clause)))
3993 (cond ((null lforminfo)
3994 ;; If there are no lexical bindings, we can do things simply. 3898 ;; If there are no lexical bindings, we can do things simply.
3995 (byte-compile-dynamic-variable-bind var)) 3899 (byte-compile-dynamic-variable-bind var))
3996 ((byte-compile-bind var init-lexenv lforminfo) 3900 ((byte-compile-bind var init-lexenv)
3997 (pop init-lexenv))))) 3901 (pop init-lexenv)))))
3998 ;; Emit the body 3902 ;; Emit the body.
3999 (byte-compile-body-do-effect (cdr (cdr form))) 3903 (byte-compile-body-do-effect (cdr (cdr form)))
4000 ;; Unbind the variables 3904 ;; Unbind the variables.
4001 (if lforminfo 3905 (if lexical-binding
4002 ;; Unbind both lexical and dynamic variables 3906 ;; Unbind both lexical and dynamic variables.
4003 (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value) 3907 (byte-compile-unbind varlist init-lexenv t)
4004 ;; Unbind dynamic variables 3908 ;; Unbind dynamic variables.
4005 (byte-compile-out 'byte-unbind (length clauses)))))) 3909 (byte-compile-out 'byte-unbind (length varlist))))))
4006 3910
4007(defun byte-compile-let* (form) 3911(defun byte-compile-let* (form)
4008 "Generate code for the `let*' form FORM." 3912 "Generate code for the `let*' form FORM."
4009 (let ((clauses (cadr form)) 3913 (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
4010 (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form))) 3914 (clauses (cadr form))
4011 (init-lexenv nil) 3915 (init-lexenv nil)
4012 (preserve-body-value (not for-effect))
4013 ;; bind these to restrict the scope of any changes 3916 ;; bind these to restrict the scope of any changes
4014 (byte-compile-bound-variables byte-compile-bound-variables) 3917
4015 (byte-compile-lexical-environment byte-compile-lexical-environment) 3918 (byte-compile-lexical-environment byte-compile-lexical-environment))
4016 (byte-compile-current-heap-environment
4017 byte-compile-current-heap-environment)
4018 (byte-compile-current-num-closures byte-compile-current-num-closures))
4019 ;; If necessary, create a new heap environment to hold some of the
4020 ;; variables bound here.
4021 (when lforminfo
4022 (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
4023 ;; Bind the variables 3919 ;; Bind the variables
4024 (dolist (clause clauses) 3920 (dolist (var clauses)
4025 (setq init-lexenv 3921 (push (byte-compile-push-binding-init var) init-lexenv)
4026 (byte-compile-push-binding-init clause init-lexenv lforminfo)) 3922 (let ((var (if (consp var) (car var) var)))
4027 (let ((var (if (consp clause) (car clause) clause))) 3923 (cond ((null lexical-binding)
4028 (cond ((null lforminfo)
4029 ;; If there are no lexical bindings, we can do things simply. 3924 ;; If there are no lexical bindings, we can do things simply.
4030 (byte-compile-dynamic-variable-bind var)) 3925 (byte-compile-dynamic-variable-bind var))
4031 ((byte-compile-bind var init-lexenv lforminfo) 3926 ((byte-compile-bind var init-lexenv)
4032 (pop init-lexenv))))) 3927 (pop init-lexenv)))))
4033 ;; Emit the body 3928 ;; Emit the body
4034 (byte-compile-body-do-effect (cdr (cdr form))) 3929 (byte-compile-body-do-effect (cdr (cdr form)))
4035 ;; Unbind the variables 3930 ;; Unbind the variables
4036 (if lforminfo 3931 (if lexical-binding
4037 ;; Unbind both lexical and dynamic variables 3932 ;; Unbind both lexical and dynamic variables
4038 (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value) 3933 (byte-compile-unbind clauses init-lexenv t)
4039 ;; Unbind dynamic variables 3934 ;; Unbind dynamic variables
4040 (byte-compile-out 'byte-unbind (length clauses))))) 3935 (byte-compile-out 'byte-unbind (length clauses)))))
4041 3936
@@ -4105,10 +4000,11 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
4105 4000
4106(defun byte-compile-condition-case (form) 4001(defun byte-compile-condition-case (form)
4107 (let* ((var (nth 1 form)) 4002 (let* ((var (nth 1 form))
4108 (byte-compile-bound-variables 4003 (fun-bodies (eq var :fun-body))
4109 (if var (cons var byte-compile-bound-variables) 4004 (byte-compile-bound-variables
4110 byte-compile-bound-variables)) 4005 (if (and var (not fun-bodies))
4111 (fun-bodies (eq var :fun-body))) 4006 (cons var byte-compile-bound-variables)
4007 byte-compile-bound-variables)))
4112 (byte-compile-set-symbol-position 'condition-case) 4008 (byte-compile-set-symbol-position 'condition-case)
4113 (unless (symbolp var) 4009 (unless (symbolp var)
4114 (byte-compile-warn 4010 (byte-compile-warn
@@ -4215,12 +4111,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
4215 (code (byte-compile-lambda (cdr (cdr form)) t)) 4111 (code (byte-compile-lambda (cdr (cdr form)) t))
4216 (for-effect nil)) 4112 (for-effect nil))
4217 (byte-compile-push-constant (nth 1 form)) 4113 (byte-compile-push-constant (nth 1 form))
4218 (if (not (byte-compile-closure-code-p code)) 4114 (byte-compile-push-constant (cons 'macro code))
4219 ;; simple lambda
4220 (byte-compile-push-constant (cons 'macro code))
4221 (byte-compile-push-constant 'macro)
4222 (byte-compile-make-closure code)
4223 (byte-compile-out 'byte-cons))
4224 (byte-compile-out 'byte-fset) 4115 (byte-compile-out 'byte-fset)
4225 (byte-compile-discard)) 4116 (byte-compile-discard))
4226 (byte-compile-constant (nth 1 form))) 4117 (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.")
85 "List of candidates for lambda lifting. 85 "List of candidates for lambda lifting.
86Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") 86Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
87 87
88(defun cconv-not-lexical-var-p (var)
89 (or (not (symbolp var)) ; form is not a list
90 (if (eval-when-compile (fboundp 'special-variable-p))
91 (special-variable-p var)
92 (boundp var))
93 ;; byte-compile-bound-variables normally holds both the
94 ;; dynamic and lexical vars, but the bytecomp.el should
95 ;; only call us at the top-level so there shouldn't be
96 ;; any lexical vars in it here.
97 (memq var byte-compile-bound-variables)
98 (memq var '(nil t))
99 (keywordp var)))
100
101(defun cconv-freevars (form &optional fvrs) 88(defun cconv-freevars (form &optional fvrs)
102 "Find all free variables of given form. 89 "Find all free variables of given form.
103Arguments: 90Arguments:
@@ -189,7 +176,7 @@ Returns a list of free variables."
189 (dolist (exp body-forms) 176 (dolist (exp body-forms)
190 (setq fvrs (cconv-freevars exp fvrs))) fvrs) 177 (setq fvrs (cconv-freevars exp fvrs))) fvrs)
191 178
192 (_ (if (cconv-not-lexical-var-p form) 179 (_ (if (byte-compile-not-lexical-var-p form)
193 fvrs 180 fvrs
194 (cons form fvrs))))) 181 (cons form fvrs)))))
195 182
@@ -704,7 +691,7 @@ Returns a form where all lambdas don't have any free variables."
704(defun cconv-analyse-function (args body env parentform inclosure) 691(defun cconv-analyse-function (args body env parentform inclosure)
705 (dolist (arg args) 692 (dolist (arg args)
706 (cond 693 (cond
707 ((cconv-not-lexical-var-p arg) 694 ((byte-compile-not-lexical-var-p arg)
708 (byte-compile-report-error 695 (byte-compile-report-error
709 (format "Argument %S is not a lexical variable" arg))) 696 (format "Argument %S is not a lexical variable" arg)))
710 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... 697 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
@@ -738,7 +725,7 @@ lambdas if they are suitable for lambda lifting.
738 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env) 725 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)
739 inclosure)) 726 inclosure))
740 727
741 (unless (cconv-not-lexical-var-p var) 728 (unless (byte-compile-not-lexical-var-p var)
742 (let ((varstruct (list var inclosure binder form))) 729 (let ((varstruct (list var inclosure binder form)))
743 (push varstruct env) ; Push a new one. 730 (push varstruct env) ; Push a new one.
744 731
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index ed266c71a59..172a74d8c80 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -529,23 +529,23 @@ suitable file is found, return nil."
529 (high (help-highlight-arguments use doc))) 529 (high (help-highlight-arguments use doc)))
530 (let ((fill-begin (point))) 530 (let ((fill-begin (point)))
531 (insert (car high) "\n") 531 (insert (car high) "\n")
532 (fill-region fill-begin (point)))) 532 (fill-region fill-begin (point)))
533 (setq doc (cdr high)))) 533 (setq doc (cdr high))))
534 (let* ((obsolete (and 534 (let* ((obsolete (and
535 ;; function might be a lambda construct. 535 ;; function might be a lambda construct.
536 (symbolp function) 536 (symbolp function)
537 (get function 'byte-obsolete-info))) 537 (get function 'byte-obsolete-info)))
538 (use (car obsolete))) 538 (use (car obsolete)))
539 (when obsolete 539 (when obsolete
540 (princ "\nThis function is obsolete") 540 (princ "\nThis function is obsolete")
541 (when (nth 2 obsolete) 541 (when (nth 2 obsolete)
542 (insert (format " since %s" (nth 2 obsolete)))) 542 (insert (format " since %s" (nth 2 obsolete))))
543 (insert (cond ((stringp use) (concat ";\n" use)) 543 (insert (cond ((stringp use) (concat ";\n" use))
544 (use (format ";\nuse `%s' instead." use)) 544 (use (format ";\nuse `%s' instead." use))
545 (t ".")) 545 (t "."))
546 "\n")) 546 "\n"))
547 (insert "\n" 547 (insert "\n"
548 (or doc "Not documented."))))))) 548 (or doc "Not documented."))))))))
549 549
550 550
551;; Variables 551;; Variables
diff --git a/src/ChangeLog b/src/ChangeLog
index f7a3fcc8b1b..6674fb31ca5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
12011-02-12 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * bytecode.c (Bvec_ref, Bvec_set): Remove.
4 (exec_byte_code): Don't handle them.
5
12010-12-27 Stefan Monnier <monnier@iro.umontreal.ca> 62010-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
2 7
3 * eval.c (Fdefvar): Record specialness before computing initial value. 8 * eval.c (Fdefvar): Record specialness before computing initial value.
diff --git a/src/bytecode.c b/src/bytecode.c
index 96d2aa273f2..9bf6ae45ce9 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -231,8 +231,6 @@ extern Lisp_Object Qand_optional, Qand_rest;
231/* Bstack_ref is code 0. */ 231/* Bstack_ref is code 0. */
232#define Bstack_set 0262 232#define Bstack_set 0262
233#define Bstack_set2 0263 233#define Bstack_set2 0263
234#define Bvec_ref 0264
235#define Bvec_set 0265
236#define BdiscardN 0266 234#define BdiscardN 0266
237 235
238#define Bconstant 0300 236#define Bconstant 0300
@@ -1722,27 +1720,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1722 case Bstack_set2: 1720 case Bstack_set2:
1723 stack.bottom[FETCH2] = POP; 1721 stack.bottom[FETCH2] = POP;
1724 break; 1722 break;
1725 case Bvec_ref:
1726 case Bvec_set:
1727 /* These byte-codes used mostly for variable references to
1728 lexically bound variables that are in an environment vector
1729 instead of on the byte-interpreter stack (generally those
1730 variables which might be shared with a closure). */
1731 {
1732 int index = FETCH;
1733 Lisp_Object vec = POP;
1734
1735 if (! VECTORP (vec))
1736 wrong_type_argument (Qvectorp, vec);
1737 else if (index < 0 || index >= XVECTOR (vec)->size)
1738 args_out_of_range (vec, make_number (index));
1739
1740 if (op == Bvec_ref)
1741 PUSH (XVECTOR (vec)->contents[index]);
1742 else
1743 XVECTOR (vec)->contents[index] = POP;
1744 }
1745 break;
1746 case BdiscardN: 1723 case BdiscardN:
1747 op = FETCH; 1724 op = FETCH;
1748 if (op & 0x80) 1725 if (op & 0x80)
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-20 10:41:08 +0000