Changeset 12875

Timestamp:

08/07/10 21:14:06 (13 years ago)

Author:

ehuelsmann

Message:

Move OPTIMIZE-INSTRUCTION-SEQUENCES and OPTIMIZE-CODE
to jvm-instructions.lisp.

Location:

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

Files:

• compiler-pass2.lisp (modified) (1 diff)
• jvm-instructions.lisp (modified) (1 diff)

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

@@ -919 +919 @@
 
 
-(defun optimize-instruction-sequences (code)
-  (let* ((code (coerce code 'vector))
-         (changed nil))
-    (dotimes (i (1- (length code)))
-      (declare (type (unsigned-byte 16) i))
-      (let* ((this-instruction (aref code i))
-             (this-opcode (and this-instruction
-                               (instruction-opcode this-instruction)))
-             (labels-skipped-p nil)
-             (next-instruction (do ((j (1+ i) (1+ j)))
-                                   ((or (>= j (length code))
-                                        (/= 202 ; LABEL
-                                            (instruction-opcode (aref code j))))
-                                    (when (< j (length code))
-                                      (aref code j)))
-                                 (setf labels-skipped-p t)))
-             (next-opcode (and next-instruction
-                               (instruction-opcode next-instruction))))
-        (case this-opcode
-          (205 ; CLEAR-VALUES
-           (when (eql next-opcode 205)       ; CLEAR-VALUES
-             (setf (aref code i) nil)
-             (setf changed t)))
-          (178 ; GETSTATIC
-           (when (and (eql next-opcode 87)   ; POP
-                      (not labels-skipped-p))
-             (setf (aref code i) nil)
-             (setf (aref code (1+ i)) nil)
-             (setf changed t)))
-          (176 ; ARETURN
-           (when (eql next-opcode 176)       ; ARETURN
-             (setf (aref code i) nil)
-             (setf changed t)))
-          ((200 167)                         ; GOTO GOTO_W
-           (when (and (or (eql next-opcode 202)  ; LABEL
-                          (eql next-opcode 200)  ; GOTO_W
-                          (eql next-opcode 167)) ; GOTO
-                      (eq (car (instruction-args this-instruction))
-                          (car (instruction-args next-instruction))))
-             (setf (aref code i) nil)
-             (setf changed t))))))
-    (values (if changed (delete nil code) code)
-            changed)))
-
-(defvar *enable-optimization* t)
-
-(defknown optimize-code () t)
-(defun optimize-code ()
-  (unless *enable-optimization*
-    (format t "optimizations are disabled~%"))
-  (when *enable-optimization*
-    (when *compiler-debug*
-      (format t "----- before optimization -----~%")
-      (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)))
-    (when *compiler-debug*
-      (sys::%format t "----- after optimization -----~%")
-      (print-code *code*)))
-  t)
 
 

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

@@ -862 +862 @@
     (values code changed)))
 
+
+(defun optimize-instruction-sequences (code)
+  (let* ((code (coerce code 'vector))
+         (changed nil))
+    (dotimes (i (1- (length code)))
+      (declare (type (unsigned-byte 16) i))
+      (let* ((this-instruction (aref code i))
+             (this-opcode (and this-instruction
+                               (instruction-opcode this-instruction)))
+             (labels-skipped-p nil)
+             (next-instruction (do ((j (1+ i) (1+ j)))
+                                   ((or (>= j (length code))
+                                        (/= 202 ; LABEL
+                                            (instruction-opcode (aref code j))))
+                                    (when (< j (length code))
+                                      (aref code j)))
+                                 (setf labels-skipped-p t)))
+             (next-opcode (and next-instruction
+                               (instruction-opcode next-instruction))))
+        (case this-opcode
+          (205 ; CLEAR-VALUES
+           (when (eql next-opcode 205)       ; CLEAR-VALUES
+             (setf (aref code i) nil)
+             (setf changed t)))
+          (178 ; GETSTATIC
+           (when (and (eql next-opcode 87)   ; POP
+                      (not labels-skipped-p))
+             (setf (aref code i) nil)
+             (setf (aref code (1+ i)) nil)
+             (setf changed t)))
+          (176 ; ARETURN
+           (when (eql next-opcode 176)       ; ARETURN
+             (setf (aref code i) nil)
+             (setf changed t)))
+          ((200 167)                         ; GOTO GOTO_W
+           (when (and (or (eql next-opcode 202)  ; LABEL
+                          (eql next-opcode 200)  ; GOTO_W
+                          (eql next-opcode 167)) ; GOTO
+                      (eq (car (instruction-args this-instruction))
+                          (car (instruction-args next-instruction))))
+             (setf (aref code i) nil)
+             (setf changed t))))))
+    (values (if changed (delete nil code) code)
+            changed)))
+
+(defvar *enable-optimization* t)
+
+(defknown optimize-code () t)
+(defun optimize-code ()
+  (unless *enable-optimization*
+    (format t "optimizations are disabled~%"))
+  (when *enable-optimization*
+    (when *compiler-debug*
+      (format t "----- before optimization -----~%")
+      (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)))
+    (when *compiler-debug*
+      (sys::%format t "----- after optimization -----~%")
+      (print-code *code*)))
+  t)
+
+
+
+
 (defun code-bytes (code)
   (let ((length 0)