195 |
(unless (member var ignore) |
(unless (member var ignore) |
196 |
(let ((vinfo |
(let ((vinfo |
197 |
(assq var (byte-compile-lforminfo-vars lforminfo)))) |
(assq var (byte-compile-lforminfo-vars lforminfo)))) |
198 |
(byte-compile-lvarinfo-note-set vinfo) |
(when vinfo |
199 |
(byte-compile-lforminfo-note-closure lforminfo vinfo |
(byte-compile-lvarinfo-note-set vinfo) |
200 |
closure-flag)))))) |
(byte-compile-lforminfo-note-closure lforminfo vinfo |
201 |
|
closure-flag))))))) |
202 |
((eq fun 'catch) |
((eq fun 'catch) |
203 |
;; tag |
;; tag |
204 |
(byte-compile-lforminfo-analyze lforminfo (cadr form) |
(byte-compile-lforminfo-analyze lforminfo (cadr form) |
361 |
(not (byte-compile-lexvar-on-stack-p lexvar))) |
(not (byte-compile-lexvar-on-stack-p lexvar))) |
362 |
|
|
363 |
(defun byte-compile-make-lambda-lexenv (form closed-over-lexenv) |
(defun byte-compile-make-lambda-lexenv (form closed-over-lexenv) |
364 |
"Make a new lexical environment for a lambda expression FORM. |
"Return a new lexical environment for a lambda expression FORM. |
365 |
CLOSED-OVER-LEXENV is the lexical environment in which FORM occurs." |
CLOSED-OVER-LEXENV is the lexical environment in which FORM occurs. |
366 |
|
The returned lexical environment contains two sets of variables: |
367 |
|
* Variables that were in CLOSED-OVER-LEXENV and used by FORM |
368 |
|
(all of these will be `heap' variables) |
369 |
|
* Arguments to FORM (all of these will be `stack' variables." |
370 |
;; See if this is a closure or not |
;; See if this is a closure or not |
371 |
(let ((closure nil) |
(let ((closure nil) |
372 |
(lforminfo (byte-compile-make-lforminfo)) |
(lforminfo (byte-compile-make-lforminfo)) |
390 |
;; innermost environment to closures, if it's in some other |
;; innermost environment to closures, if it's in some other |
391 |
;; envionment, there must be path to it from the innermost |
;; envionment, there must be path to it from the innermost |
392 |
;; one). |
;; one). |
393 |
|
(unless (byte-compile-lexvar-in-heap-p vinfo) |
394 |
|
;; To access the variable from FORM, it must be in the heap. |
395 |
|
(error |
396 |
|
"Compiler error: lexical variable `%s' should be heap-allocated but is not" |
397 |
|
(car vinfo))) |
398 |
(byte-compile-heapenv-ensure-access |
(byte-compile-heapenv-ensure-access |
399 |
byte-compile-current-heap-environment |
byte-compile-current-heap-environment |
400 |
(byte-compile-lexvar-environment |
(byte-compile-lexvar-environment |
416 |
;; Return the new lexical environment |
;; Return the new lexical environment |
417 |
lexenv)))) |
lexenv)))) |
418 |
|
|
419 |
(defun byte-compile-closure-lexenv-p (lexenv) |
(defun byte-compile-closure-initial-lexenv-p (lexenv) |
420 |
"Return non-nil if LEXENV is the initial lexical environment for a closure. |
"Return non-nil if LEXENV is the initial lexical environment for a closure. |
421 |
This only works correctly when passed a new lexical environment as returned |
This only works correctly when passed a new lexical environment as |
422 |
by `byte-compile-make-lambda-lexenv'." |
returned by `byte-compile-make-lambda-lexenv' (it works by checking to |
423 |
|
see whether there are any heap-allocated lexical variables in LEXENV)." |
424 |
(let ((closure nil)) |
(let ((closure nil)) |
425 |
(while (and lexenv (not closure)) |
(while (and lexenv (not closure)) |
426 |
(when (byte-compile-lexvar-environment-p (pop lexenv)) |
(when (byte-compile-lexvar-environment-p (pop lexenv)) |
496 |
(defun byte-compile-non-stack-bindings-p (clauses lforminfo) |
(defun byte-compile-non-stack-bindings-p (clauses lforminfo) |
497 |
"Return non-nil if any lexical bindings in CLAUSES are not stack-allocated. |
"Return non-nil if any lexical bindings in CLAUSES are not stack-allocated. |
498 |
LFORMINFO should be information about lexical variables being bound." |
LFORMINFO should be information about lexical variables being bound." |
499 |
(or (not (= (length clauses) (length lforminfo))) |
(let ((vars (byte-compile-lforminfo-vars lforminfo))) |
500 |
(progn |
(or (not (= (length clauses) (length vars))) |
501 |
(while (and lforminfo clauses) |
(progn |
502 |
(when (byte-compile-lvarinfo-closed-over-p (pop lforminfo)) |
(while (and vars clauses) |
503 |
(setq clauses nil))) |
(when (byte-compile-lvarinfo-closed-over-p (pop vars)) |
504 |
(not clauses)))) |
(setq clauses nil))) |
505 |
|
(not clauses))))) |
506 |
|
|
507 |
(defun byte-compile-let-clauses-trivial-init-p (clauses) |
(defun byte-compile-let-clauses-trivial-init-p (clauses) |
508 |
"Return true if let binding CLAUSES all have a `trivial' init value. |
"Return true if let binding CLAUSES all have a `trivial' init value. |
558 |
;; the same as the number inside the binding form that created the |
;; the same as the number inside the binding form that created the |
559 |
;; currently active heap environment. |
;; currently active heap environment. |
560 |
(let ((nclosures |
(let ((nclosures |
561 |
(if lforminfo (byte-compile-lforminfo-num-closures lforminfo) -1))) |
(and lforminfo (byte-compile-lforminfo-num-closures lforminfo)))) |
562 |
(if (and byte-compile-current-heap-environment |
(if (or (null lforminfo) |
563 |
(or (zerop nclosures) |
(= nclosures byte-compile-current-num-closures)) |
|
(= nclosures byte-compile-current-num-closures))) |
|
564 |
;; No need to push a heap environment. |
;; No need to push a heap environment. |
565 |
nil |
nil |
566 |
;; Have to push one. A heap environment is really just a vector, so |
;; Have to push one. A heap environment is really just a vector, so |
593 |
;; VAR is dynamic, but we have to get its |
;; VAR is dynamic, but we have to get its |
594 |
;; value out of the middle of the stack |
;; value out of the middle of the stack |
595 |
(let ((stack-pos (cdr (assq var init-lexenv)))) |
(let ((stack-pos (cdr (assq var init-lexenv)))) |
596 |
(byte-compile-out 'byte-stack-ref stack-pos) |
(byte-compile-stack-ref stack-pos) |
597 |
(byte-compile-dynamic-variable-bind var) |
(byte-compile-dynamic-variable-bind var) |
598 |
;; Now we have to store nil into its temporary |
;; Now we have to store nil into its temporary |
599 |
;; stack position to avoid problems with GC |
;; stack position to avoid problems with GC |
600 |
(byte-compile-push-constant nil) |
(byte-compile-push-constant nil) |
601 |
(byte-compile-out 'byte-stack-set stack-pos)) |
(byte-compile-stack-set stack-pos)) |
602 |
nil) |
nil) |
603 |
((byte-compile-lvarinfo-closed-over-p vinfo) |
((byte-compile-lvarinfo-closed-over-p vinfo) |
604 |
;; VAR is lexical, but needs to be in a |
;; VAR is lexical, but needs to be in a |
623 |
byte-compile-lexical-environment)))) |
byte-compile-lexical-environment)))) |
624 |
(unless env-vec-stack-pos |
(unless env-vec-stack-pos |
625 |
(error "Couldn't find location of current heap environment!")) |
(error "Couldn't find location of current heap environment!")) |
626 |
(if init-stack-pos |
(when init-stack-pos |
627 |
;; VAR is not on the top of the stack, so get it |
;; VAR is not on the top of the stack, so get it |
628 |
(byte-compile-out 'byte-stack-ref init-stack-pos) |
(byte-compile-stack-ref init-stack-pos)) |
629 |
;; Record that we've popped VAR's init value |
(byte-compile-stack-ref env-vec-stack-pos) |
|
(pop init-lexenv)) |
|
|
(byte-compile-out 'byte-stack-ref env-vec-stack-pos) |
|
630 |
;; Store the variable into the vector |
;; Store the variable into the vector |
631 |
(byte-compile-out 'byte-vec-set env-vec-pos) |
(byte-compile-out 'byte-vec-set env-vec-pos) |
632 |
(when init-stack-pos |
(when init-stack-pos |
633 |
;; Store nil into VAR's temporary stack |
;; Store nil into VAR's temporary stack |
634 |
;; position to avoid problems with GC |
;; position to avoid problems with GC |
635 |
(byte-compile-push-constant nil) |
(byte-compile-push-constant nil) |
636 |
(byte-compile-out 'byte-stack-set init-stack-pos)) |
(byte-compile-stack-set init-stack-pos)) |
637 |
;; Push a record of VAR's new lexical binding |
;; Push a record of VAR's new lexical binding |
638 |
(push (byte-compile-make-lexvar |
(push (byte-compile-make-lexvar |
639 |
var env-vec-pos byte-compile-current-heap-environment) |
var env-vec-pos byte-compile-current-heap-environment) |
667 |
;; return value of the body. |
;; return value of the body. |
668 |
(when init-lexenv |
(when init-lexenv |
669 |
;; INIT-LEXENV contains all init values left on the stack |
;; INIT-LEXENV contains all init values left on the stack |
670 |
(when preserve-body-value |
(byte-compile-discard (length init-lexenv) preserve-body-value))) |
|
;; Preserve the return value of the body, which is now on the |
|
|
;; top of the stack, by storing it directly into the stack |
|
|
;; position which will be at TOS after we pop. |
|
|
(byte-compile-out 'byte-stack-set (cdr (last init-lexenv))) |
|
|
(pop init-lexenv)) |
|
|
(while init-lexenv |
|
|
(byte-compile-discard) |
|
|
(pop init-lexenv)))) |
|
671 |
|
|
672 |
|
|
673 |
(provide 'byte-lexbind) |
(provide 'byte-lexbind) |