Changeset 11818


Ignore:
Timestamp:
05/03/09 08:07:28 (14 years ago)
Author:
ehuelsmann
Message:

Harmonize the concept of 'block needing non-local-exit'
by centralizing the definition.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r11807 r11818  
    317317                    (when (eq enclosing-block block)
    318318                      (return nil))
    319                     (when (equal (block-name enclosing-block) '(UNWIND-PROTECT))
     319                    (when (block-requires-non-local-exit-p enclosing-block)
    320320                      (return t)))))
    321321             (dformat t "p1-return-from protected = ~S~%" protected)
     
    370370                      (when (eq enclosing-block tag-block)
    371371                        (return nil))
    372                       (when (equal (block-name enclosing-block) '(UNWIND-PROTECT))
     372                      (when (block-requires-non-local-exit-p enclosing-block)
    373373                        (return t)))))
    374374               (when protected
     
    696696(defun p1-progv (form)
    697697  ;; We've already checked argument count in PRECOMPILE-PROGV.
     698
     699  ;; ### FIXME: we need to return a block here, so that
     700  ;;  (local) GO in p2 can restore the lastSpecialBinding environment
    698701  (let ((new-form (rewrite-progv form)))
    699702    (when (neq new-form form)
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11817 r11818  
    45414541                (when (eq enclosing-block tag-block)
    45424542                  (return nil))
    4543                 (let ((block-name (block-name enclosing-block)))
    4544                   (when (or (equal block-name '(CATCH))
    4545                             (equal block-name '(UNWIND-PROTECT)))
    4546                     (return t))))))
     4543                (when (block-requires-non-local-exit-p enclosing-block)
     4544                  (return t)))))
    45474545        (unless protected
    45484546          (dolist (block *blocks*)
     
    47294727                 (when (eq enclosing-block block)
    47304728                   (return nil))
    4731                  (when (equal (block-name enclosing-block) '(UNWIND-PROTECT))
     4729                 (when (block-requires-non-local-exit-p enclosing-block)
    47324730                   (return t)))))
    47334731          (unless protected
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r11783 r11818  
    380380         nil)))
    381381
     382(defknown block-requires-non-local-exit-p (t) boolean)
     383(defun block-requires-non-local-exit-p (object)
     384  "A block which *always* requires a 'non-local-exit' is a block which
     385requires a transfer control exception to be thrown: e.g. Go and Return.
     386
     387Non-local exits are required by blocks which do more in their cleanup
     388than just restore the lastSpecialBinding (= dynamic environment).
     389"
     390  (memq (block-name object) '(CATCH UNWIND-PROTECT)))
     391
    382392(defvar *blocks* ())
    383393
Note: See TracChangeset for help on using the changeset viewer.