Changeset 11818
- Timestamp:
- 05/03/09 08:07:28 (14 years ago)
- 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 317 317 (when (eq enclosing-block block) 318 318 (return nil)) 319 (when ( equal (block-name enclosing-block) '(UNWIND-PROTECT))319 (when (block-requires-non-local-exit-p enclosing-block) 320 320 (return t))))) 321 321 (dformat t "p1-return-from protected = ~S~%" protected) … … 370 370 (when (eq enclosing-block tag-block) 371 371 (return nil)) 372 (when ( equal (block-name enclosing-block) '(UNWIND-PROTECT))372 (when (block-requires-non-local-exit-p enclosing-block) 373 373 (return t))))) 374 374 (when protected … … 696 696 (defun p1-progv (form) 697 697 ;; 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 698 701 (let ((new-form (rewrite-progv form))) 699 702 (when (neq new-form form) -
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11817 r11818 4541 4541 (when (eq enclosing-block tag-block) 4542 4542 (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))))) 4547 4545 (unless protected 4548 4546 (dolist (block *blocks*) … … 4729 4727 (when (eq enclosing-block block) 4730 4728 (return nil)) 4731 (when ( equal (block-name enclosing-block) '(UNWIND-PROTECT))4729 (when (block-requires-non-local-exit-p enclosing-block) 4732 4730 (return t))))) 4733 4731 (unless protected -
trunk/abcl/src/org/armedbear/lisp/jvm.lisp
r11783 r11818 380 380 nil))) 381 381 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 385 requires a transfer control exception to be thrown: e.g. Go and Return. 386 387 Non-local exits are required by blocks which do more in their cleanup 388 than just restore the lastSpecialBinding (= dynamic environment). 389 " 390 (memq (block-name object) '(CATCH UNWIND-PROTECT))) 391 382 392 (defvar *blocks* ()) 383 393
Note: See TracChangeset
for help on using the changeset viewer.