/[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.6 by miles, Wed Jul 31 07:30:56 2002 UTC revision 1.1.2.7 by miles, Sat Aug 17 14:46:28 2002 UTC
# Line 195  LFORMINFO." Line 195  LFORMINFO."
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)
# Line 360  inside a lambda expression that may clos Line 361  inside a lambda expression that may clos
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))
# Line 385  CLOSED-OVER-LEXENV is the lexical enviro Line 390  CLOSED-OVER-LEXENV is the lexical enviro
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
# Line 406  CLOSED-OVER-LEXENV is the lexical enviro Line 416  CLOSED-OVER-LEXENV is the lexical enviro
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))
# Line 485  If not, then add a new slot to HEAPENV p Line 496  If not, then add a new slot to HEAPENV p
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.
# Line 546  proper scope)." Line 558  proper scope)."
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
# Line 582  Return non-nil if the TOS value was popp Line 593  Return non-nil if the TOS value was popp
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
# Line 612  Return non-nil if the TOS value was popp Line 623  Return non-nil if the TOS value was popp
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)
# Line 658  binding slots have been popped." Line 667  binding slots have been popped."
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)

Legend:
Removed from v.1.1.2.6  
changed lines
  Added in v.1.1.2.7

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