/[emacs]/emacs/lisp/emacs-lisp/byte-lexbind.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/byte-lexbind.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.2.3 by miles, Wed Jun 12 06:30:54 2002 UTC revision 1.1.2.4 by miles, Wed Jun 12 17:04:13 2002 UTC
# Line 59  This means that the body of the form mus Line 59  This means that the body of the form mus
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))
# Line 81  This means that the body of the form mus Line 81  This means that the body of the form mus
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    
# Line 96  describes the variable.  CLOSURE-FLAG is Line 96  describes the variable.  CLOSURE-FLAG is
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))))
# Line 119  where: Line 119  where:
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*)
# Line 137  where: Line 137  where:
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)
# Line 151  where: Line 151  where:
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    
# Line 163  The first element of LAMBDA is ignored; Line 163  The first element of LAMBDA is ignored;
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
# Line 193  LFORMINFO." Line 193  LFORMINFO."
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))))))
# Line 259  LFORMINFO." Line 260  LFORMINFO."
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
# Line 449  by `byte-compile-make-lambda-lexenv'." Line 450  by `byte-compile-make-lambda-lexenv'."
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 ()
# Line 474  Return a `lexvar' descriptor for the new Line 475  Return a `lexvar' descriptor for the new
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    
# Line 516  LFORMINFO should be information about le Line 517  LFORMINFO should be information about le
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)))
# Line 570  Return non-nil if the TOS value was popp Line 571  Return non-nil if the TOS value was popp
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
# Line 623  Return non-nil if the TOS value was popp Line 624  Return non-nil if the TOS value was popp
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)
# Line 648  binding slots have been popped." Line 649  binding slots have been popped."
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)))

Legend:
Removed from v.1.1.2.3  
changed lines
  Added in v.1.1.2.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26