Changeset 11832

Timestamp:

05/05/09 17:22:31 (14 years ago)

Author:

vvoutilainen

Message:

Cleanup for saving/restoring dynamic environment.

File:

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

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

@@ -3953 +3953 @@
   t)
 
+(defun restore-dynamic-environment (register)
+  (emit-push-current-thread)
+  (aload register)
+  (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
+  +lisp-special-binding+))
+
+(defun save-dynamic-environment (register)
+  (emit-push-current-thread)
+  (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
+  +lisp-special-binding+)
+  (astore register))
+
 (defun p2-m-v-b-node (block target)
   (let* ((*blocks* (cons block *blocks*))
@@ -3976 +3988 @@
       ;; Save current dynamic environment.
       (setf (block-environment-register block) (allocate-register))
-      (emit-push-current-thread)
-      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-      (astore (block-environment-register block))
+      (save-dynamic-environment (block-environment-register block))
       (label label-START))
     ;; Make sure there are no leftover values from previous calls.
@@ -4041 +4050 @@
       (emit 'goto label-EXIT)
       (label label-END)
-      (aload *thread*)
-      (aload (block-environment-register block))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
+      (restore-dynamic-environment (block-environment-register block))
       (emit 'athrow)
 
       ;; Restore dynamic environment.
       (label label-EXIT)
-      (aload *thread*)
-      (aload (block-environment-register block))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
+      (restore-dynamic-environment (block-environment-register block))
       (push (make-handler :from label-START
                           :to label-END
@@ -4381 +4384 @@
       ;; We need to save current dynamic environment.
       (setf (block-environment-register block) (allocate-register))
-      (emit-push-current-thread)
-      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-      (astore (block-environment-register block))
+      (save-dynamic-environment (block-environment-register block))
       (label label-START))
     (propagate-vars block)
@@ -4403 +4403 @@
       (label label-END)
       ;; Restore dynamic environment.
-      (aload *thread*)
-      (aload (block-environment-register block))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
+      (restore-dynamic-environment (block-environment-register block))
       (emit 'athrow)
 
       (label label-EXIT)
-      (aload *thread*)
-      (aload (block-environment-register block))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-
+      (restore-dynamic-environment (block-environment-register block))
       (push (make-handler :from label-START
                           :to label-END
@@ -4459 +4452 @@
       ;; Non-local transfers of control restore the environment
       ;; themselves (in the finally of LET/LET*, etc.
-      (emit-push-current-thread)
-      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-      (astore environment-register))
+      (save-dynamic-environment environment-register))
     (label BEGIN-BLOCK)
     (do* ((rest body (cdr rest))
@@ -4543 +4533 @@
       (when (block-environment-register tag-block)
         ;; If there's a dynamic environment to restore, do it.
-        (aload *thread*)
-        (aload (block-environment-register tag-block))
-        (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-              +lisp-special-binding+))
+  (restore-dynamic-environment (block-environment-register tag-block)))
       (maybe-generate-interrupt-check)
       (emit 'goto (tag-label tag))
@@ -4653 +4640 @@
                   ;; Save the current dynamic environment.
                   (setf (block-environment-register block) (allocate-register))
-                  (emit-push-current-thread)
-                  (emit 'getfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+)
-                  (astore (block-environment-register block)))
+      (save-dynamic-environment (block-environment-register block)))
                  (t
                   (dformat t "no specials~%")))
@@ -4694 +4679 @@
            (when (block-environment-register block)
              ;; We saved the dynamic environment above. Restore it now.
-             (aload *thread*)
-             (aload (block-environment-register block))
-             (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+))
+       (restore-dynamic-environment (block-environment-register block)))
            (fix-boxing representation nil)
            )
@@ -4816 +4799 @@
                  (single-valued-p values-form))
       (emit-clear-values))
-    (emit-push-current-thread)
-    (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
-          +lisp-special-binding+)
-    (astore environment-register)
+    (save-dynamic-environment environment-register)
     (label label-START)
     ;; Compile call to Lisp.progvBindVars().
-    (aload *thread*)
+    (emit-push-current-thread)
     (emit-invokestatic +lisp-class+ "progvBindVars"
                        (list +lisp-object+ +lisp-object+ +lisp-thread+) nil)
@@ -4829 +4809 @@
     (emit 'goto label-EXIT)
     (label label-END)
-    (aload *thread*)
-    (aload environment-register)
-    (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-          +lisp-special-binding+)
+    (restore-dynamic-environment environment-register)
     (emit 'athrow)
 
     ;; Restore dynamic environment.
     (label label-EXIT)
-    (aload *thread*)
-    (aload environment-register)
-    (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-          +lisp-special-binding+)
+    (restore-dynamic-environment environment-register)
     (fix-boxing representation nil)
     (push (make-handler :from label-START
@@ -7819 +7793 @@
       ;; catch-all handler, which will do a re-throw.
       (emit 'if_acmpne DEFAULT-HANDLER) ; Stack depth is 1.
-      (aload *thread*)
+      (emit-push-current-thread)
       (emit-invokevirtual +lisp-throw-class+ "getResult"
                           (list +lisp-thread+) +lisp-object+)
@@ -7826 +7800 @@
       (label DEFAULT-HANDLER) ; Start of handler for all other Throwables.
       ;; A Throwable object is on the runtime stack here. Stack depth is 1.
-      (aload *thread*)
+      (emit-push-current-thread)
       (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
       (emit 'athrow) ; Re-throw.
       (label EXIT)
       ;; Finally...
-      (aload *thread*)
+      (emit-push-current-thread)
       (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
       (let ((handler1 (make-handler :from BEGIN-PROTECTED-RANGE
@@ -8311 +8285 @@
       (setf (compiland-environment-register compiland)
             (allocate-register))
-      (emit-push-current-thread)
-      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-      (astore (compiland-environment-register compiland))
+      (save-dynamic-environment (compiland-environment-register compiland))
       (label label-START)
       (dolist (variable (compiland-arg-vars compiland))
@@ -8340 +8311 @@
       (emit 'goto label-EXIT)
       (label label-END)
-      (emit-push-current-thread)
-      (aload (compiland-environment-register compiland))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
+      (restore-dynamic-environment (compiland-environment-register compiland))
       (emit 'athrow)
 
       ;; Restore dynamic environment
       (label label-EXIT)
-      (emit-push-current-thread)
-      (aload (compiland-environment-register compiland))
-      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
-            +lisp-special-binding+)
-
+      (restore-dynamic-environment (compiland-environment-register compiland))
       (push (make-handler :from label-START
                           :to label-END
@@ -8379 +8343 @@
                (ensure-thread-var-initialized)
                (maybe-initialize-thread-var)
-               (aload *thread*)
+         (emit-push-current-thread)
                (emit-invokevirtual *this-class* "processArgs"
                                    (list +lisp-object-array+ +lisp-thread+)