Changeset 12844 for branches/generic-class-file/abcl/src/org/armedbear

Timestamp:

08/01/10 18:05:04 (13 years ago)

Author:

ehuelsmann

Message:

Centralize exception-handler registration/accumulation;
while at it, remove a utility function from jvm-class-file.lisp
which should have been in compiler-pass2.lisp.

Location:

branches/generic-class-file/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (7 diffs)
• jvm-class-file.lisp (modified) (1 diff)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -198 +198 @@
   (u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
           n)))
+
+
+(defun add-exception-handler (start end handler type)
+  (if (null *current-code-attribute*)
+      (push (make-handler :from start
+                          :to end
+                          :code handler
+                          :catch-type (if (null type)
+                                          0
+                                          (pool-class (!class-name type))))
+            *handlers*)
+      (code-add-exception-handler *current-code-attribute*
+                                  start end handler type)))
 
 
@@ -3972 +3985 @@
     (label label-EXIT)
     (restore-dynamic-environment register)
-    (push (make-handler :from label-START
-      :to label-END
-      :code label-END
-      :catch-type 0) *handlers*)))
+    (add-exception-handler label-START label-END label-END nil)))
 
 (defun p2-m-v-b-node (block target)
@@ -4507 +4517 @@
         (emit 'athrow)
         ;; Finally...
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code HANDLER
-                            :catch-type (pool-class (!class-name +lisp-go+)))
-              *handlers*)
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code EXTENT-EXIT-HANDLER
-                            :catch-type 0)
-              *handlers*)))
+        (add-exception-handler BEGIN-BLOCK END-BLOCK HANDLER +lisp-go+)
+        (add-exception-handler BEGIN-BLOCK END-BLOCK EXTENT-EXIT-HANDLER nil)))
     (label EXIT)
     (when (tagbody-non-local-go-p block)
@@ -4678 +4680 @@
         (emit-move-from-stack target) ; Stack depth is 0.
         ;; Finally...
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code HANDLER
-                            :catch-type (pool-class (!class-name +lisp-return+)))
-              *handlers*)
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code EXTENT-EXIT-HANDLER
-                            :catch-type 0)
-              *handlers*)))
+        (add-exception-handler BEGIN-BLOCK END-BLOCK HANDLER +lisp-return+)
+        (add-exception-handler BEGIN-BLOCK END-BLOCK EXTENT-EXIT-HANDLER nil)))
     (label BLOCK-EXIT)
     (when (block-id-variable block)
@@ -7623 +7617 @@
     (aload object-register)
     (emit 'monitorexit)
-    (push (make-handler :from BEGIN-PROTECTED-RANGE
-                        :to END-PROTECTED-RANGE
-                        :code END-PROTECTED-RANGE
-                        :catch-type 0) *handlers*)))
+    (add-exception-handler BEGIN-PROTECTED-RANGE
+                           END-PROTECTED-RANGE
+                           END-PROTECTED-RANGE nil)))
 
 
@@ -7677 +7670 @@
       (emit-push-current-thread)
       (emit-invokevirtual +lisp-thread+ "popCatchTag" nil nil)
-      (let ((handler1 (make-handler :from BEGIN-PROTECTED-RANGE
-                                    :to END-PROTECTED-RANGE
-                                    :code THROW-HANDLER
-                                    :catch-type (pool-class (!class-name +lisp-throw+))))
-            (handler2 (make-handler :from BEGIN-PROTECTED-RANGE
-                                    :to END-PROTECTED-RANGE
-                                    :code DEFAULT-HANDLER
-                                    :catch-type 0)))
-        (push handler1 *handlers*)
-        (push handler2 *handlers*))))
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE
+                             THROW-HANDLER +lisp-throw+)
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE
+                             DEFAULT-HANDLER nil)))
   t)
 
@@ -7772 +7761 @@
       (aload result-register)
       (emit-move-from-stack target)
-      (let ((handler (make-handler :from BEGIN-PROTECTED-RANGE
-                                   :to END-PROTECTED-RANGE
-                                   :code HANDLER
-                                   :catch-type 0)))
-        (push handler *handlers*)))))
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE HANDLER nil))))
 
 (defknown compile-form (t t t) t)

branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -865 +865 @@
         (code-exception-handlers code)))
 
-(defun add-exception-handler (start end handler type)
-  (code-add-exception-handler *current-code-attribute* start end handler type))
-
 (defstruct exception
   start-pc    ;; label target