Changeset 11847

Timestamp:

05/09/09 00:15:55 (15 years ago)

Author:

vvoutilainen

Message:

Clean up duplication for environment restoration and handlers.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (10 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -3953 +3953 @@
   (astore register))
 
+(defun restore-environment-and-make-handler (register label-START)
+  (let ((label-END (gensym))
+  (label-EXIT (gensym)))
+    (emit 'goto label-EXIT)
+    (label label-END)
+    (restore-dynamic-environment register)
+    (emit 'athrow)
+    ;; Restore dynamic environment.
+    (label label-EXIT)
+    (restore-dynamic-environment register)
+    (push (make-handler :from label-START
+      :to label-END
+      :code label-END
+      :catch-type 0) *handlers*)))
+
 (defun p2-m-v-b-node (block target)
   (let* ((*blocks* (cons block *blocks*))
@@ -3961 +3976 @@
          (bind-special-p nil)
          (variables (block-vars block))
-         (label-START (gensym))
-         (label-END (gensym))
-         (label-EXIT (gensym)))
+         (label-START (gensym)))
     (dolist (variable variables)
       (let ((special-p (variable-special-p variable)))
@@ -4036 +4049 @@
     (compile-progn-body (cdddr form) target)
     (when bind-special-p
-      (emit 'goto label-EXIT)
-      (label label-END)
-      (restore-dynamic-environment (block-environment-register block))
-      (emit 'athrow)
-
-      ;; Restore dynamic environment.
-      (label label-EXIT)
-      (restore-dynamic-environment (block-environment-register block))
-      (push (make-handler :from label-START
-                          :to label-END
-                          :code label-END
-                          :catch-type 0) *handlers*))))
+      (restore-environment-and-make-handler (block-environment-register block)
+              label-START))))
 
 (defun propagate-vars (block)
@@ -4359 +4362 @@
          (*visible-variables* *visible-variables*)
          (specialp nil)
-         (label-START (gensym))
-         (label-END (gensym))
-         (label-EXIT (gensym)))
+         (label-START (gensym)))
     ;; Walk the variable list looking for special bindings and unused lexicals.
     (dolist (variable (block-vars block))
@@ -4388 +4389 @@
       (compile-progn-body (cddr form) target representation))
     (when specialp
-      (emit 'goto label-EXIT)
-      (label label-END)
-      ;; Restore dynamic environment.
-      (restore-dynamic-environment (block-environment-register block))
-      (emit 'athrow)
-
-      (label label-EXIT)
-      (restore-dynamic-environment (block-environment-register block))
-      (push (make-handler :from label-START
-                          :to label-END
-                          :code label-END
-                          :catch-type 0) *handlers*))))
+      (restore-environment-and-make-handler (block-environment-register block)
+              label-START))))
 
 (defun p2-locally (form target representation)
@@ -4773 +4764 @@
 
 (defun p2-progv-node (block target representation)
+  (declare (ignore representation))
   (let* ((form (block-form block))
          (symbols-form (cadr form))
@@ -4779 +4771 @@
          (environment-register
           (setf (block-environment-register block) (allocate-register)))
-         (label-START (gensym))
-         (label-END (gensym))
-         (label-EXIT (gensym)))
+         (label-START (gensym)))
     (compile-form symbols-form 'stack nil)
     (compile-form values-form 'stack nil)
@@ -4795 +4785 @@
       ;; Implicit PROGN.
     (let ((*blocks* (cons block *blocks*)))
-      (compile-progn-body (cdddr form) target)
-      (emit 'goto label-EXIT)
-      (label label-END)
-      (restore-dynamic-environment environment-register)
-      (emit 'athrow))
-
-    ;; Restore dynamic environment.
-    (label label-EXIT)
-    (restore-dynamic-environment environment-register)
-    (fix-boxing representation nil)
-    (push (make-handler :from label-START
-                          :to label-END
-                          :code label-END
-                          :catch-type 0) *handlers*)))
+      (compile-progn-body (cdddr form) target))
+    (restore-environment-and-make-handler environment-register label-START)))
 
 (defun p2-quote (form target representation)
@@ -8087 +8065 @@
          (*initialize-thread-var* nil)
          (super nil)
-         (label-START (gensym))
-         (label-END (gensym))
-         (label-EXIT (gensym)))
+         (label-START (gensym)))
 
     (dolist (var (compiland-arg-vars compiland))
@@ -8246 +8222 @@
 
     (when (compiland-environment-register compiland)
-      (emit 'goto label-EXIT)
-      (label label-END)
-      (restore-dynamic-environment (compiland-environment-register compiland))
-      (emit 'athrow)
-
-      ;; Restore dynamic environment
-      (label label-EXIT)
-      (restore-dynamic-environment (compiland-environment-register compiland))
-      (push (make-handler :from label-START
-                          :to label-END
-                          :code label-END
-                          :catch-type 0) *handlers*))
+      (restore-environment-and-make-handler 
+       (compiland-environment-register compiland) label-START))
 
     (unless *code*