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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Aug  6 18:37:16 2010
New Revision: 12868

Log:
Miscelanious fixes.

Modified:
   branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.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	Fri Aug  6 18:37:16 2010
@@ -927,7 +927,7 @@
     (dotimes (i (length code))
       (declare (type (unsigned-byte 16) i))
       (let ((instruction (aref code i)))
-        (when (branch-opcode-p (instruction-opcode instruction))
+        (when (branch-p (instruction-opcode instruction))
           (let ((label (car (instruction-args instruction))))
             (set label marker)))))
     ;; Add labels used for exception handlers.
@@ -1077,7 +1077,7 @@
         (setf changed-p (or (optimize-2b) changed-p))
         (setf changed-p (or (optimize-3) changed-p))
         (if changed-p
-            (setf *code* delete-unreachable-code *code*)
+            (setf *code* (delete-unreachable-code *code*))
             (multiple-value-setq
                 (*code* changed-p)
               (delete-unreachable-code *code*)))
@@ -1112,7 +1112,7 @@
       (dotimes (i (length code))
         (declare (type (unsigned-byte 16) i))
         (let ((instruction (aref code i)))
-          (when (branch-opcode-p (instruction-opcode instruction))
+          (when (branch-p (instruction-opcode instruction))
             (let* ((label (car (instruction-args instruction)))
                    (offset (- (the (unsigned-byte 16) (symbol-value (the symbol label))) index)))
               (setf (instruction-args instruction) (s2 offset))))

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp	Fri Aug  6 18:37:16 2010
@@ -397,13 +397,13 @@
 (defun branch-p (opcode)
   (declare (optimize speed))
   (declare (type '(integer 0 255) opcode))
-  (or (<= 153 opcode 168)
+  (or (<= 153 opcode 167)
       (<= 198 opcode 200))) ;; ifnull / ifnonnull / goto_w
 
 (declaim (ftype (function (t) t) unconditional-control-transfer-p)
          (inline unconditional-control-transfer-p))
 (defun unconditional-control-transfer-p (opcode)
-  (or (= 168 opcode) ;; goto
+  (or (= 167 opcode) ;; goto
       (= 200 opcode) ;; goto_w
       (<= 172 opcode 177) ;; ?return
       (= 191 opcode) ;; athrow
@@ -719,7 +719,7 @@
       (let ((opcode (instruction-opcode instruction)))
         (setf depth (+ depth instruction-stack))
         (setf (instruction-depth instruction) depth)
-        (when (branch-opcode-p opcode)
+        (when (branch-p opcode)
           (let ((label (car (instruction-args instruction))))
             (declare (type symbol label))
             (analyze-stack-path code (symbol-value label) depth)))