Changeset 11820 for trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
- Timestamp:
- 05/03/09 10:10:21 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11819 r11820 4450 4450 (END-BLOCK (gensym)) 4451 4451 (EXIT (gensym)) 4452 (must-clear-values nil)) 4452 (must-clear-values nil) 4453 environment-register) 4454 (when (block-needs-environment-restoration block) 4455 (setf environment-register (allocate-register) 4456 (block-environment-register block) environment-register)) 4453 4457 ;; Scan for tags. 4454 4458 (dolist (subform body) … … 4457 4461 (push tag local-tags) 4458 4462 (push tag *visible-tags*)))) 4463 4464 (when environment-register 4465 ;; Note: we store the environment register, 4466 ;; but since we don't manipulate the environment, 4467 ;; we don't need to restore. 4468 ;; 4469 ;; It's here so local transfers of control can restore 4470 ;; what we started with. 4471 ;; 4472 ;; Non-local transfers of control restore the environment 4473 ;; themselves (in the finally of LET/LET*, etc. 4474 (emit-push-current-thread) 4475 (emit 'getfield +lisp-thread-class+ "lastSpecialBinding" 4476 +lisp-special-binding+) 4477 (astore environment-register)) 4459 4478 (label BEGIN-BLOCK) 4460 4479 (do* ((rest body (cdr rest)) … … 4523 4542 (declare (ignore representation)) 4524 4543 (let* ((name (cadr form)) 4525 (tag (find-tag name))) 4544 (tag (find-tag name)) 4545 (tag-block (when tag (tag-block tag)))) 4526 4546 (unless tag 4527 4547 (error "p2-go: tag not found: ~S" name)) 4528 (when (eq (tag-compiland tag) *current-compiland*) 4529 ;; Local case. 4530 (let* ((tag-block (tag-block tag)) 4531 (register nil)) 4532 (unless (enclosed-by-protected-block-p tag-block) 4533 (dolist (block *blocks*) 4534 (if (eq block tag-block) 4535 (return) 4536 (setf register (or (block-environment-register block) register)))) 4537 (when register 4538 ;; Restore dynamic environment. 4539 (aload *thread*) 4540 (aload register) 4541 (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" 4542 +lisp-special-binding+)) 4543 (maybe-generate-interrupt-check) 4544 (emit 'goto (tag-label tag)) 4545 (return-from p2-go)))) 4548 (when (and (eq (tag-compiland tag) *current-compiland*) 4549 (not (enclosed-by-protected-block-p tag-block))) 4550 ;; Local case with local transfer of control 4551 ;; Note: Local case with non-local transfer of control handled below 4552 (when (block-environment-register tag-block) 4553 ;; If there's a dynamic environment to restore, do it. 4554 (aload *thread*) 4555 (aload (block-environment-register tag-block)) 4556 (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" 4557 +lisp-special-binding+)) 4558 (maybe-generate-interrupt-check) 4559 (emit 'goto (tag-label tag)) 4560 (return-from p2-go)) 4546 4561 ;; Non-local GO. 4547 4562 (emit 'new +lisp-go-class+)
Note: See TracChangeset
for help on using the changeset viewer.