Changeset 13021
- Timestamp:
- 11/11/10 12:40:40 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r13020 r13021 2998 2998 (compile-progn-body (cdddr form) target)) 2999 2999 (when bind-special-p 3000 (restore-environment-and-make-handler (m-v-b-environment-register block) 3001 label-START)))) 3000 (restore-dynamic-environment (m-v-b-environment-register block))))) 3002 3001 3003 3002 (defun propagate-vars (block) … … 3356 3355 (compile-progn-body (cddr form) target representation))) 3357 3356 (when specialp 3358 (restore-environment-and-make-handler (let-environment-register block) 3359 label-START)))) 3357 (restore-dynamic-environment (let-environment-register block))))) 3360 3358 3361 3359 (defknown p2-locally-node (t t t) t) … … 3380 3378 (RETHROW (gensym)) 3381 3379 (EXIT (gensym)) 3382 (must-clear-values nil)) 3380 (must-clear-values nil) 3381 (specials-register (when (tagbody-non-local-go-p block) 3382 (allocate-register)))) 3383 3383 ;; Scan for tags. 3384 3384 (dolist (tag (tagbody-tags block)) … … 3392 3392 (emit-invokespecial-init +lisp-object+ '()) 3393 3393 (emit-new-closure-binding (tagbody-id-variable block))) 3394 (when (tagbody-non-local-go-p block) 3395 (save-dynamic-environment specials-register)) 3394 3396 (label BEGIN-BLOCK) 3395 3397 (do* ((rest body (cdr rest)) … … 3428 3430 (emit-getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1. 3429 3431 (astore tag-register) 3432 (restore-dynamic-environment specials-register) 3430 3433 ;; Don't actually generate comparisons for tags 3431 3434 ;; to which there is no non-local GO instruction … … 3573 3576 (BEGIN-BLOCK (gensym)) 3574 3577 (END-BLOCK (gensym)) 3575 (BLOCK-EXIT (block-exit block))) 3578 (BLOCK-EXIT (block-exit block)) 3579 (specials-register (when (block-non-local-return-p block) 3580 (allocate-register)))) 3576 3581 (setf (block-target block) target) 3577 3582 (when (block-id-variable block) … … 3584 3589 (dformat t "*all-variables* = ~S~%" 3585 3590 (mapcar #'variable-name *all-variables*)) 3591 (when (block-non-local-return-p block) 3592 (save-dynamic-environment specials-register)) 3586 3593 (label BEGIN-BLOCK) ; Start of protected range, for non-local returns 3587 3594 ;; Implicit PROGN. … … 3611 3618 (emit 'athrow) 3612 3619 (label THIS-BLOCK) 3620 (restore-dynamic-environment specials-register) 3613 3621 (emit-getfield +lisp-return+ "result" +lisp-object+) 3614 3622 (emit-move-from-stack target) ; Stack depth is 0. … … 3732 3740 (let ((*blocks* (cons block *blocks*))) 3733 3741 (compile-progn-body (cdddr form) target representation)) 3734 (restore- environment-and-make-handler environment-register label-START)))3742 (restore-dynamic-environment environment-register))) 3735 3743 3736 3744 (defun p2-quote (form target representation) … … 6449 6457 (RETHROW (gensym)) 6450 6458 (DEFAULT-HANDLER (gensym)) 6451 (EXIT (gensym))) 6459 (EXIT (gensym)) 6460 (specials-register (allocate-register))) 6452 6461 (compile-form (second form) tag-register nil) ; Tag. 6453 6462 (emit-push-current-thread) … … 6457 6466 (let ((*blocks* (cons block *blocks*))) 6458 6467 ; Stack depth is 0. 6468 (save-dynamic-environment specials-register) 6459 6469 (label BEGIN-PROTECTED-RANGE) ; Start of protected range. 6460 6470 (compile-progn-body (cddr form) target) ; Implicit PROGN. … … 6469 6479 ;; catch-all handler, which will do a re-throw. 6470 6480 (emit 'if_acmpne RETHROW) ; Stack depth is 1. 6481 (restore-dynamic-environment specials-register) 6471 6482 (emit-push-current-thread) 6472 6483 (emit-invokevirtual +lisp-throw+ "getResult" … … 6534 6545 (result-register (allocate-register)) 6535 6546 (values-register (allocate-register)) 6547 (specials-register (allocate-register)) 6536 6548 (BEGIN-PROTECTED-RANGE (gensym)) 6537 6549 (END-PROTECTED-RANGE (gensym)) … … 6542 6554 6543 6555 (let* ((*blocks* (cons block *blocks*))) 6556 (save-dynamic-environment specials-register) 6544 6557 (label BEGIN-PROTECTED-RANGE) 6545 6558 (compile-form protected-form result-register nil) … … 6561 6574 (emit-getfield +lisp-thread+ "_values" +lisp-object-array+) 6562 6575 (astore values-register) 6576 (restore-dynamic-environment specials-register) 6563 6577 (let ((*register* *register*)) 6564 6578 (compile-progn-body cleanup-forms nil nil)) … … 6908 6922 6909 6923 (when (compiland-environment-register compiland) 6910 (restore-environment-and-make-handler 6911 (compiland-environment-register compiland) label-START)) 6924 (restore-dynamic-environment (compiland-environment-register compiland))) 6912 6925 6913 6926 (unless *code*
Note: See TracChangeset
for help on using the changeset viewer.