59 |
;; lvarinfo: |
;; lvarinfo: |
60 |
;; constructor |
;; constructor |
61 |
(defsubst byte-compile-make-lvarinfo (var &optional already-set) |
(defsubst byte-compile-make-lvarinfo (var &optional already-set) |
62 |
`(,var 0 ,(if already-set 1 0) 0) nil) |
`(,var 0 ,(if already-set 1 0) 0 nil)) |
63 |
;; accessors |
;; accessors |
64 |
(defsubst byte-compile-lvarinfo-var (vinfo) (car vinfo)) |
(defsubst byte-compile-lvarinfo-var (vinfo) (car vinfo)) |
65 |
(defsubst byte-compile-lvarinfo-numrefs (vinfo) (cadr vinfo)) |
(defsubst byte-compile-lvarinfo-numrefs (vinfo) (cadr vinfo)) |
81 |
(defalias 'byte-compile-lforminfo-vars 'car) |
(defalias 'byte-compile-lforminfo-vars 'car) |
82 |
(defalias 'byte-compile-lforminfo-num-closures 'cdr) |
(defalias 'byte-compile-lforminfo-num-closures 'cdr) |
83 |
;; setters |
;; setters |
84 |
(defalias byte-compile-lforminfo-add-var (finfo var &optional already-set) |
(defsubst byte-compile-lforminfo-add-var (finfo var &optional already-set) |
85 |
(setcar finfo (cons (byte-compile-make-lvarinfo var already-set) |
(setcar finfo (cons (byte-compile-make-lvarinfo var already-set) |
86 |
(car finfo)))) |
(car finfo)))) |
87 |
|
|
96 |
inside a closure, and otherwise a `closure flag' returned by |
inside a closure, and otherwise a `closure flag' returned by |
97 |
`byte-compile-lforminfo-make-closure-flag'." |
`byte-compile-lforminfo-make-closure-flag'." |
98 |
(when closure-flag |
(when closure-flag |
99 |
(byte-compile-lvarinfo-note-closure vinfo) |
(byte-compile-lvarinfo-note-closure lvarinfo) |
100 |
(unless (car closure-flag) |
(unless (car closure-flag) |
101 |
(setcdr lforminfo (1+ (cdr lforminfo))) |
(setcdr lforminfo (1+ (cdr lforminfo))) |
102 |
(setcar closure-flag t)))) |
(setcar closure-flag t)))) |
119 |
(cond ((eq (car form) 'let) |
(cond ((eq (car form) 'let) |
120 |
;; Find the bound variables |
;; Find the bound variables |
121 |
(dolist (clause (cadr form)) |
(dolist (clause (cadr form)) |
122 |
(let ((var (if (consp claus) (car clause) clause))) |
(let ((var (if (consp clause) (car clause) clause))) |
123 |
(unless (memq var special) |
(unless (memq var special) |
124 |
(byte-compile-lforminfo-add-var lforminfo var t)))) |
(byte-compile-lforminfo-add-var lforminfo var t)))) |
125 |
;; Analyze the body |
;; Analyze the body |
126 |
(unless (null (byte-compile-lformat-info-vars lforminfo)) |
(unless (null (byte-compile-lforminfo-vars lforminfo)) |
127 |
(byte-compile-lforminfo-analyze-forms lforminfo form 2 |
(byte-compile-lforminfo-analyze-forms lforminfo form 2 |
128 |
special nil))) |
special nil))) |
129 |
((eq (car form) 'let*) |
((eq (car form) 'let*) |
137 |
(unless (memq var special) |
(unless (memq var special) |
138 |
(byte-compile-lforminfo-add-var lforminfo var t)))) |
(byte-compile-lforminfo-add-var lforminfo var t)))) |
139 |
;; Analyze the body |
;; Analyze the body |
140 |
(unless (null (byte-compile-lformat-info-vars lforminfo)) |
(unless (null (byte-compile-lforminfo-vars lforminfo)) |
141 |
(byte-compile-lforminfo-analyze-forms lforminfo form 2 |
(byte-compile-lforminfo-analyze-forms lforminfo form 2 |
142 |
special nil))) |
special nil))) |
143 |
((eq (car form) 'condition-case) |
((eq (car form) 'condition-case) |
151 |
((and (consp (car form)) (eq (caar form) 'lambda)) |
((and (consp (car form)) (eq (caar form) 'lambda)) |
152 |
;; An embedded lambda, which is basically just a `let' |
;; An embedded lambda, which is basically just a `let' |
153 |
(byte-compile-lforminfo-from-lambda lforminfo (cdr form) special))) |
(byte-compile-lforminfo-from-lambda lforminfo (cdr form) special))) |
154 |
(if (byte-compile-lformat-info-vars lforminfo) |
(if (byte-compile-lforminfo-vars lforminfo) |
155 |
lforminfo |
lforminfo |
156 |
nil)))) |
nil)))) |
157 |
|
|
163 |
(dolist (arg (byte-compile-arglist-vars (cadr lambda))) |
(dolist (arg (byte-compile-arglist-vars (cadr lambda))) |
164 |
(byte-compile-lforminfo-add-var lforminfo arg t)) |
(byte-compile-lforminfo-add-var lforminfo arg t)) |
165 |
;; Analyze the body |
;; Analyze the body |
166 |
(unless (null (byte-compile-lformat-info-vars lforminfo)) |
(unless (null (byte-compile-lforminfo-vars lforminfo)) |
167 |
(byte-compile-lforminfo-analyze-forms lforminfo lambda 2 special nil))) |
(byte-compile-lforminfo-analyze-forms lforminfo lambda 2 special nil))) |
168 |
|
|
169 |
(defun byte-compile-lforminfo-analyze (lforminfo form ignore closure-flag) |
(defun byte-compile-lforminfo-analyze (lforminfo form &optional ignore closure-flag) |
170 |
"Update variable information in LFORMINFO by analyzing FORM. |
"Update variable information in LFORMINFO by analyzing FORM. |
171 |
IGNORE is a list of variables that shouldn't be analyzed (usually because |
IGNORE is a list of variables that shouldn't be analyzed (usually because |
172 |
they're special, or because some inner binding shadows the version in |
they're special, or because some inner binding shadows the version in |
193 |
(byte-compile-lforminfo-analyze lforminfo (pop form) |
(byte-compile-lforminfo-analyze lforminfo (pop form) |
194 |
ignore closure-flag) |
ignore closure-flag) |
195 |
(unless (member var ignore) |
(unless (member var ignore) |
196 |
(let ((vinfo (assq var lforminfo))) |
(let ((vinfo |
197 |
|
(assq var (byte-compile-lforminfo-vars lforminfo)))) |
198 |
(byte-compile-lvarinfo-note-set vinfo) |
(byte-compile-lvarinfo-note-set vinfo) |
199 |
(byte-compile-lforminfo-note-closure lforminfo vinfo |
(byte-compile-lforminfo-note-closure lforminfo vinfo |
200 |
closure-flag)))))) |
closure-flag)))))) |
260 |
(dolist (clause (cadr form)) |
(dolist (clause (cadr form)) |
261 |
(if (symbolp clause) |
(if (symbolp clause) |
262 |
(push clause ignore) |
(push clause ignore) |
263 |
(byte-compile-lforminfo-analyze lforminfo (cadr claus) |
(byte-compile-lforminfo-analyze lforminfo (cadr clause) |
264 |
ignore closure-flag) |
ignore closure-flag) |
265 |
(push (car clause) ignore))) |
(push (car clause) ignore))) |
266 |
;; analyze body |
;; analyze body |
450 |
(defun byte-compile-heapenv-add-accessible-env (heapenv env offset) |
(defun byte-compile-heapenv-add-accessible-env (heapenv env offset) |
451 |
"Add to HEAPENV's list of accessible environments, ENV at OFFSET." |
"Add to HEAPENV's list of accessible environments, ENV at OFFSET." |
452 |
(setcdr (nthcdr 2 heapenv) |
(setcdr (nthcdr 2 heapenv) |
453 |
(cons (cons accessible-env offset) |
(cons (cons env offset) |
454 |
(byte-compile-heapenv-accessible-envs heapenv)))) |
(byte-compile-heapenv-accessible-envs heapenv)))) |
455 |
|
|
456 |
(defun byte-compile-push-heapenv () |
(defun byte-compile-push-heapenv () |
475 |
(defun byte-compile-heapenv-ensure-access (heapenv other-heapenv) |
(defun byte-compile-heapenv-ensure-access (heapenv other-heapenv) |
476 |
"Make sure that HEAPENV can be used to access OTHER-HEAPENV. |
"Make sure that HEAPENV can be used to access OTHER-HEAPENV. |
477 |
If not, then add a new slot to HEAPENV pointing to OTHER-HEAPENV." |
If not, then add a new slot to HEAPENV pointing to OTHER-HEAPENV." |
478 |
(unless (memq env (byte-compile-heapenv-accessible-envs heapenv)) |
(unless (memq heapenv (byte-compile-heapenv-accessible-envs heapenv)) |
479 |
(let ((offset (byte-compile-heapenv-add-slot heapenv))) |
(let ((offset (byte-compile-heapenv-add-slot heapenv))) |
480 |
(byte-compile-heapenv-add-accessible-env heapenv other-heapenv offset)))) |
(byte-compile-heapenv-add-accessible-env heapenv other-heapenv offset)))) |
481 |
|
|
517 |
(let* ((clause (pop clauses)) |
(let* ((clause (pop clauses)) |
518 |
(var (if (consp clause) (car clause) clause)) |
(var (if (consp clause) (car clause) clause)) |
519 |
(init (and (consp clause) (cadr clause))) |
(init (and (consp clause) (cadr clause))) |
520 |
(vinfo (assq var lforminfo))) |
(vinfo (assq var (byte-compile-lforminfo-vars lforminfo)))) |
521 |
(cond |
(cond |
522 |
((or (and vinfo |
((or (and vinfo |
523 |
(not (byte-compile-lvarinfo-closed-over-p vinfo))) |
(not (byte-compile-lvarinfo-closed-over-p vinfo))) |
571 |
;; juggle things on the stack, either to move them to TOS for |
;; juggle things on the stack, either to move them to TOS for |
572 |
;; dynamic binding, or to put them in a non-stack environment |
;; dynamic binding, or to put them in a non-stack environment |
573 |
;; vector. |
;; vector. |
574 |
(let ((vinfo (assq var lforminfo))) |
(let ((vinfo (assq var (byte-compile-lforminfo-vars lforminfo)))) |
575 |
(unless (and vinfo (zerop (byte-compile-lvarinfo-numrefs vinfo))) |
(unless (and vinfo (zerop (byte-compile-lvarinfo-numrefs vinfo))) |
576 |
(cond ((and (null vinfo) (eq var (caar init-lexenv))) |
(cond ((and (null vinfo) (eq var (caar init-lexenv))) |
577 |
;; VAR is dynamic and is on the top of the |
;; VAR is dynamic and is on the top of the |
624 |
;; Store nil into VAR's temporary stack |
;; Store nil into VAR's temporary stack |
625 |
;; position to avoid problems with GC |
;; position to avoid problems with GC |
626 |
(byte-compile-push-constant nil) |
(byte-compile-push-constant nil) |
627 |
(byte-compile-out 'byte-stack-set stack-pos)) |
(byte-compile-out 'byte-stack-set init-stack-pos)) |
628 |
;; Push a record of VAR's new lexical binding |
;; Push a record of VAR's new lexical binding |
629 |
(push (byte-compile-make-lexvar |
(push (byte-compile-make-lexvar |
630 |
var env-vec-pos byte-compile-current-heap-environment) |
var env-vec-pos byte-compile-current-heap-environment) |
649 |
;; Unbind dynamic variables |
;; Unbind dynamic variables |
650 |
(let ((num-dynamic-bindings 0)) |
(let ((num-dynamic-bindings 0)) |
651 |
(dolist (clause clauses) |
(dolist (clause clauses) |
652 |
(unless (assq (if (consp clause) (car clause) clause) lforminfo) |
(unless (assq (if (consp clause) (car clause) clause) |
653 |
|
(byte-compile-lforminfo-vars lforminfo)) |
654 |
(setq num-dynamic-bindings (1+ num-dynamic-bindings)))) |
(setq num-dynamic-bindings (1+ num-dynamic-bindings)))) |
655 |
(unless (zerop num-dynamic-bindings) |
(unless (zerop num-dynamic-bindings) |
656 |
(byte-compile-out 'byte-unbind num-dynamic-bindings))) |
(byte-compile-out 'byte-unbind num-dynamic-bindings))) |