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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun Aug  8 09:16:53 2010
New Revision: 12877

Log:
Optimization functions optimize in tight loops, optimize for speed.
Also, remove iterator variable type declarations: our inferencer
knows their type.

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

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	Sun Aug  8 09:16:53 2010
@@ -733,7 +733,6 @@
   (let* ((code-length (length code)))
     (declare (type vector code))
     (dotimes (i code-length)
-      (declare (type (unsigned-byte 16) i))
       (let* ((instruction (aref code i))
              (opcode (instruction-opcode instruction)))
         (when (eql opcode 202) ; LABEL
@@ -762,7 +761,6 @@
     (let ((max-stack 0))
       (declare (type fixnum max-stack))
       (dotimes (i code-length)
-        (declare (type (unsigned-byte 16) i))
         (let* ((instruction (aref code i))
                (instruction-depth (instruction-depth instruction)))
           (when instruction-depth
@@ -771,12 +769,12 @@
 
 
 (defun delete-unused-labels (code handler-labels)
+  (declare (optimize speed))
   (let ((code (coerce code 'vector))
         (changed nil)
         (marker (gensym)))
     ;; Mark the labels that are actually branched to.
     (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
       (let ((instruction (aref code i)))
         (when (branch-p (instruction-opcode instruction))
           (let ((label (car (instruction-args instruction))))
@@ -786,7 +784,6 @@
       (set label marker))
     ;; Remove labels that are not used as branch targets.
     (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
       (let ((instruction (aref code i)))
         (when (= (instruction-opcode instruction) 202) ; LABEL
           (let ((label (car (instruction-args instruction))))
@@ -799,6 +796,7 @@
 
 (defun delete-unreachable-code (code)
   ;; Look for unreachable code after GOTO.
+  (declare (optimize speed))
   (let* ((code (coerce code 'vector))
          (changed nil)
          (after-goto/areturn nil))
@@ -825,7 +823,6 @@
         (code (coerce code 'vector))
         (pending-labels '()))
     (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
       (let ((instruction (aref code i)))
         (cond ((label-p instruction)
                (push (instruction-label instruction) pending-labels))
@@ -838,11 +835,11 @@
     ht))
 
 (defun optimize-jumps (code)
+  (declare (optimize speed))
   (let* ((code (coerce code 'vector))
          (ht (label-target-instructions code))
          (changed nil))
     (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
       (let* ((instruction (aref code i))
              (opcode (and instruction (instruction-opcode instruction))))
         (when (and opcode (branch-p opcode))
@@ -866,7 +863,6 @@
   (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)))