[armedbear-cvs] r12872 - branches/generic-class-file/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Aug  7 08:30:05 2010
New Revision: 12872

Log:
In OPTIMIZE-3, do not consider LABELs a 'next instruction',
skip them instead.

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

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sat Aug  7 08:30:05 2010
@@ -928,7 +928,14 @@
       (let* ((this-instruction (aref code i))
              (this-opcode (and this-instruction
                                (instruction-opcode this-instruction)))
-             (next-instruction (aref code (1+ i)))
+             (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
@@ -937,7 +944,8 @@
              (setf (aref code i) nil)
              (setf changed t)))
           (178 ; GETSTATIC
-           (when (eql next-opcode 87) ; POP
+           (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)))
@@ -946,7 +954,6 @@
                       (eq (car (instruction-args this-instruction))
                           (car (instruction-args next-instruction))))
              (setf (aref code i) nil)
-             ;;(setf (aref code (1+ i)) nil)
              (setf changed t))))))
     (when changed
       (setf *code* (delete nil code))