Changeset 11847
- Timestamp:
- 05/09/09 00:15:55 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11846 r11847 3953 3953 (astore register)) 3954 3954 3955 (defun restore-environment-and-make-handler (register label-START) 3956 (let ((label-END (gensym)) 3957 (label-EXIT (gensym))) 3958 (emit 'goto label-EXIT) 3959 (label label-END) 3960 (restore-dynamic-environment register) 3961 (emit 'athrow) 3962 ;; Restore dynamic environment. 3963 (label label-EXIT) 3964 (restore-dynamic-environment register) 3965 (push (make-handler :from label-START 3966 :to label-END 3967 :code label-END 3968 :catch-type 0) *handlers*))) 3969 3955 3970 (defun p2-m-v-b-node (block target) 3956 3971 (let* ((*blocks* (cons block *blocks*)) … … 3961 3976 (bind-special-p nil) 3962 3977 (variables (block-vars block)) 3963 (label-START (gensym)) 3964 (label-END (gensym)) 3965 (label-EXIT (gensym))) 3978 (label-START (gensym))) 3966 3979 (dolist (variable variables) 3967 3980 (let ((special-p (variable-special-p variable))) … … 4036 4049 (compile-progn-body (cdddr form) target) 4037 4050 (when bind-special-p 4038 (emit 'goto label-EXIT) 4039 (label label-END) 4040 (restore-dynamic-environment (block-environment-register block)) 4041 (emit 'athrow) 4042 4043 ;; Restore dynamic environment. 4044 (label label-EXIT) 4045 (restore-dynamic-environment (block-environment-register block)) 4046 (push (make-handler :from label-START 4047 :to label-END 4048 :code label-END 4049 :catch-type 0) *handlers*)))) 4051 (restore-environment-and-make-handler (block-environment-register block) 4052 label-START)))) 4050 4053 4051 4054 (defun propagate-vars (block) … … 4359 4362 (*visible-variables* *visible-variables*) 4360 4363 (specialp nil) 4361 (label-START (gensym)) 4362 (label-END (gensym)) 4363 (label-EXIT (gensym))) 4364 (label-START (gensym))) 4364 4365 ;; Walk the variable list looking for special bindings and unused lexicals. 4365 4366 (dolist (variable (block-vars block)) … … 4388 4389 (compile-progn-body (cddr form) target representation)) 4389 4390 (when specialp 4390 (emit 'goto label-EXIT) 4391 (label label-END) 4392 ;; Restore dynamic environment. 4393 (restore-dynamic-environment (block-environment-register block)) 4394 (emit 'athrow) 4395 4396 (label label-EXIT) 4397 (restore-dynamic-environment (block-environment-register block)) 4398 (push (make-handler :from label-START 4399 :to label-END 4400 :code label-END 4401 :catch-type 0) *handlers*)))) 4391 (restore-environment-and-make-handler (block-environment-register block) 4392 label-START)))) 4402 4393 4403 4394 (defun p2-locally (form target representation) … … 4773 4764 4774 4765 (defun p2-progv-node (block target representation) 4766 (declare (ignore representation)) 4775 4767 (let* ((form (block-form block)) 4776 4768 (symbols-form (cadr form)) … … 4779 4771 (environment-register 4780 4772 (setf (block-environment-register block) (allocate-register))) 4781 (label-START (gensym)) 4782 (label-END (gensym)) 4783 (label-EXIT (gensym))) 4773 (label-START (gensym))) 4784 4774 (compile-form symbols-form 'stack nil) 4785 4775 (compile-form values-form 'stack nil) … … 4795 4785 ;; Implicit PROGN. 4796 4786 (let ((*blocks* (cons block *blocks*))) 4797 (compile-progn-body (cdddr form) target) 4798 (emit 'goto label-EXIT) 4799 (label label-END) 4800 (restore-dynamic-environment environment-register) 4801 (emit 'athrow)) 4802 4803 ;; Restore dynamic environment. 4804 (label label-EXIT) 4805 (restore-dynamic-environment environment-register) 4806 (fix-boxing representation nil) 4807 (push (make-handler :from label-START 4808 :to label-END 4809 :code label-END 4810 :catch-type 0) *handlers*))) 4787 (compile-progn-body (cdddr form) target)) 4788 (restore-environment-and-make-handler environment-register label-START))) 4811 4789 4812 4790 (defun p2-quote (form target representation) … … 8087 8065 (*initialize-thread-var* nil) 8088 8066 (super nil) 8089 (label-START (gensym)) 8090 (label-END (gensym)) 8091 (label-EXIT (gensym))) 8067 (label-START (gensym))) 8092 8068 8093 8069 (dolist (var (compiland-arg-vars compiland)) … … 8246 8222 8247 8223 (when (compiland-environment-register compiland) 8248 (emit 'goto label-EXIT) 8249 (label label-END) 8250 (restore-dynamic-environment (compiland-environment-register compiland)) 8251 (emit 'athrow) 8252 8253 ;; Restore dynamic environment 8254 (label label-EXIT) 8255 (restore-dynamic-environment (compiland-environment-register compiland)) 8256 (push (make-handler :from label-START 8257 :to label-END 8258 :code label-END 8259 :catch-type 0) *handlers*)) 8224 (restore-environment-and-make-handler 8225 (compiland-environment-register compiland) label-START)) 8260 8226 8261 8227 (unless *code*
Note: See TracChangeset
for help on using the changeset viewer.