Changeset 12876

Timestamp:

08/08/10 10:06:35 (13 years ago)

Author:

ehuelsmann

Message:

Move FINALIZE-CODE to jvm-instructions.lisp and make it
really finalize all code.

Location:

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

Files:

• compiler-pass2.lisp (modified) (3 diffs)
• jvm-instructions.lisp (modified) (4 diffs)

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

@@ -914 +914 @@
   (check-number-of-args form n t))
 
-
-(defun finalize-code ()
-  (setf *code* (nreverse (coerce *code* 'vector))))
 
 
@@ -1187 +1184 @@
     (setf *code* (append *static-code* *code*))
     (emit 'return)
-    (finalize-code)
-    (setf *code* (resolve-instructions (expand-virtual-instructions *code*)))
+    (setf *code*
+          (finalize-code *code* (nconc (mapcar #'handler-from *handlers*)
+                                       (mapcar #'handler-to *handlers*)
+                                       (mapcar #'handler-code *handlers*)) nil))
+
     (setf (method-max-stack constructor)
           (analyze-stack *code* (mapcar #'handler-code *handlers*)))
@@ -7486 +7486 @@
 
     ;;;  Move here
-    (finalize-code)
-    (optimize-code)
-
-    (setf *code* (resolve-instructions (expand-virtual-instructions *code*)))
+    (setf *code* (finalize-code *code*
+                                (nconc (mapcar #'handler-from *handlers*)
+                                       (mapcar #'handler-to *handlers*)
+                                       (mapcar #'handler-code *handlers*)) t))
+
     (setf (method-max-stack execute-method)
           (analyze-stack *code* (mapcar #'handler-code *handlers*)))

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

@@ -820 +820 @@
 
 
-(declaim (ftype (function (t) hash-table) hash-labels))
+(declaim (ftype (function (t) label-target-instructions) hash-labels))
 (defun label-target-instructions (code)
   (let ((ht (make-hash-table :test 'eq))
@@ -909 +909 @@
 (defvar *enable-optimization* t)
 
-(defknown optimize-code () t)
-(defun optimize-code ()
+(defknown optimize-code (t t) t)
+(defun optimize-code (code handler-labels)
   (unless *enable-optimization*
     (format t "optimizations are disabled~%"))
@@ -916 +916 @@
     (when *compiler-debug*
       (format t "----- before optimization -----~%")
-      (print-code *code*))
+      (print-code code))
     (loop
-      (let ((changed-p nil))
-        (multiple-value-setq
-            (*code* changed-p)
-          (delete-unused-labels *code*
-                                (nconc
-                                 (mapcar #'handler-from *handlers*)
-                                 (mapcar #'handler-to *handlers*)
-                                 (mapcar #'handler-code *handlers*))))
-        (if changed-p
-            (setf *code* (optimize-instruction-sequences *code*))
-            (multiple-value-setq
-                (*code* changed-p)
-              (optimize-instruction-sequences *code*)))
-        (if changed-p
-            (setf *code* (optimize-jumps *code*))
-            (multiple-value-setq
-                (*code* changed-p)
-              (optimize-jumps *code*)))
-        (if changed-p
-            (setf *code* (delete-unreachable-code *code*))
-            (multiple-value-setq
-                (*code* changed-p)
-              (delete-unreachable-code *code*)))
-        (unless changed-p
-          (return))))
-    (unless (vectorp *code*)
-      (setf *code* (coerce *code* 'vector)))
+       (let ((changed-p nil))
+         (multiple-value-setq
+             (code changed-p)
+           (delete-unused-labels code handler-labels))
+         (if changed-p
+             (setf code (optimize-instruction-sequences code))
+             (multiple-value-setq
+                 (code changed-p)
+               (optimize-instruction-sequences code)))
+         (if changed-p
+             (setf code (optimize-jumps code))
+             (multiple-value-setq
+                 (code changed-p)
+               (optimize-jumps code)))
+         (if changed-p
+             (setf code (delete-unreachable-code code))
+             (multiple-value-setq
+                 (code changed-p)
+               (delete-unreachable-code code)))
+         (unless changed-p
+           (return))))
+    (unless (vectorp code)
+      (setf code (coerce code 'vector)))
     (when *compiler-debug*
       (sys::%format t "----- after optimization -----~%")
-      (print-code *code*)))
-  t)
+      (print-code code)))
+  code)
 
 
@@ -998 +994 @@
       (values bytes labels))))
 
-
+(defun finalize-code (code handler-labels optimize)
+  (setf code (coerce (nreverse code) 'vector))
+  (when optimize
+    (setf code (optimize-code code handler-labels)))
+  (resolve-instructions (expand-virtual-instructions code)))
 
 (provide '#:opcodes)