Changeset 12875


Ignore:
Timestamp:
08/07/10 21:14:06 (12 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:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12874 r12875  
    919919
    920920
    921 (defun optimize-instruction-sequences (code)
    922   (let* ((code (coerce code 'vector))
    923          (changed nil))
    924     (dotimes (i (1- (length code)))
    925       (declare (type (unsigned-byte 16) i))
    926       (let* ((this-instruction (aref code i))
    927              (this-opcode (and this-instruction
    928                                (instruction-opcode this-instruction)))
    929              (labels-skipped-p nil)
    930              (next-instruction (do ((j (1+ i) (1+ j)))
    931                                    ((or (>= j (length code))
    932                                         (/= 202 ; LABEL
    933                                             (instruction-opcode (aref code j))))
    934                                     (when (< j (length code))
    935                                       (aref code j)))
    936                                  (setf labels-skipped-p t)))
    937              (next-opcode (and next-instruction
    938                                (instruction-opcode next-instruction))))
    939         (case this-opcode
    940           (205 ; CLEAR-VALUES
    941            (when (eql next-opcode 205)       ; CLEAR-VALUES
    942              (setf (aref code i) nil)
    943              (setf changed t)))
    944           (178 ; GETSTATIC
    945            (when (and (eql next-opcode 87)   ; POP
    946                       (not labels-skipped-p))
    947              (setf (aref code i) nil)
    948              (setf (aref code (1+ i)) nil)
    949              (setf changed t)))
    950           (176 ; ARETURN
    951            (when (eql next-opcode 176)       ; ARETURN
    952              (setf (aref code i) nil)
    953              (setf changed t)))
    954           ((200 167)                         ; GOTO GOTO_W
    955            (when (and (or (eql next-opcode 202)  ; LABEL
    956                           (eql next-opcode 200)  ; GOTO_W
    957                           (eql next-opcode 167)) ; GOTO
    958                       (eq (car (instruction-args this-instruction))
    959                           (car (instruction-args next-instruction))))
    960              (setf (aref code i) nil)
    961              (setf changed t))))))
    962     (values (if changed (delete nil code) code)
    963             changed)))
    964 
    965 (defvar *enable-optimization* t)
    966 
    967 (defknown optimize-code () t)
    968 (defun optimize-code ()
    969   (unless *enable-optimization*
    970     (format t "optimizations are disabled~%"))
    971   (when *enable-optimization*
    972     (when *compiler-debug*
    973       (format t "----- before optimization -----~%")
    974       (print-code *code*))
    975     (loop
    976       (let ((changed-p nil))
    977         (multiple-value-setq
    978             (*code* changed-p)
    979           (delete-unused-labels *code*
    980                                 (nconc
    981                                  (mapcar #'handler-from *handlers*)
    982                                  (mapcar #'handler-to *handlers*)
    983                                  (mapcar #'handler-code *handlers*))))
    984         (if changed-p
    985             (setf *code* (optimize-instruction-sequences *code*))
    986             (multiple-value-setq
    987                 (*code* changed-p)
    988               (optimize-instruction-sequences *code*)))
    989         (if changed-p
    990             (setf *code* (optimize-jumps *code*))
    991             (multiple-value-setq
    992                 (*code* changed-p)
    993               (optimize-jumps *code*)))
    994         (if changed-p
    995             (setf *code* (delete-unreachable-code *code*))
    996             (multiple-value-setq
    997                 (*code* changed-p)
    998               (delete-unreachable-code *code*)))
    999         (unless changed-p
    1000           (return))))
    1001     (unless (vectorp *code*)
    1002       (setf *code* (coerce *code* 'vector)))
    1003     (when *compiler-debug*
    1004       (sys::%format t "----- after optimization -----~%")
    1005       (print-code *code*)))
    1006   t)
    1007921
    1008922
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

    r12873 r12875  
    862862    (values code changed)))
    863863
     864
     865(defun optimize-instruction-sequences (code)
     866  (let* ((code (coerce code 'vector))
     867         (changed nil))
     868    (dotimes (i (1- (length code)))
     869      (declare (type (unsigned-byte 16) i))
     870      (let* ((this-instruction (aref code i))
     871             (this-opcode (and this-instruction
     872                               (instruction-opcode this-instruction)))
     873             (labels-skipped-p nil)
     874             (next-instruction (do ((j (1+ i) (1+ j)))
     875                                   ((or (>= j (length code))
     876                                        (/= 202 ; LABEL
     877                                            (instruction-opcode (aref code j))))
     878                                    (when (< j (length code))
     879                                      (aref code j)))
     880                                 (setf labels-skipped-p t)))
     881             (next-opcode (and next-instruction
     882                               (instruction-opcode next-instruction))))
     883        (case this-opcode
     884          (205 ; CLEAR-VALUES
     885           (when (eql next-opcode 205)       ; CLEAR-VALUES
     886             (setf (aref code i) nil)
     887             (setf changed t)))
     888          (178 ; GETSTATIC
     889           (when (and (eql next-opcode 87)   ; POP
     890                      (not labels-skipped-p))
     891             (setf (aref code i) nil)
     892             (setf (aref code (1+ i)) nil)
     893             (setf changed t)))
     894          (176 ; ARETURN
     895           (when (eql next-opcode 176)       ; ARETURN
     896             (setf (aref code i) nil)
     897             (setf changed t)))
     898          ((200 167)                         ; GOTO GOTO_W
     899           (when (and (or (eql next-opcode 202)  ; LABEL
     900                          (eql next-opcode 200)  ; GOTO_W
     901                          (eql next-opcode 167)) ; GOTO
     902                      (eq (car (instruction-args this-instruction))
     903                          (car (instruction-args next-instruction))))
     904             (setf (aref code i) nil)
     905             (setf changed t))))))
     906    (values (if changed (delete nil code) code)
     907            changed)))
     908
     909(defvar *enable-optimization* t)
     910
     911(defknown optimize-code () t)
     912(defun optimize-code ()
     913  (unless *enable-optimization*
     914    (format t "optimizations are disabled~%"))
     915  (when *enable-optimization*
     916    (when *compiler-debug*
     917      (format t "----- before optimization -----~%")
     918      (print-code *code*))
     919    (loop
     920      (let ((changed-p nil))
     921        (multiple-value-setq
     922            (*code* changed-p)
     923          (delete-unused-labels *code*
     924                                (nconc
     925                                 (mapcar #'handler-from *handlers*)
     926                                 (mapcar #'handler-to *handlers*)
     927                                 (mapcar #'handler-code *handlers*))))
     928        (if changed-p
     929            (setf *code* (optimize-instruction-sequences *code*))
     930            (multiple-value-setq
     931                (*code* changed-p)
     932              (optimize-instruction-sequences *code*)))
     933        (if changed-p
     934            (setf *code* (optimize-jumps *code*))
     935            (multiple-value-setq
     936                (*code* changed-p)
     937              (optimize-jumps *code*)))
     938        (if changed-p
     939            (setf *code* (delete-unreachable-code *code*))
     940            (multiple-value-setq
     941                (*code* changed-p)
     942              (delete-unreachable-code *code*)))
     943        (unless changed-p
     944          (return))))
     945    (unless (vectorp *code*)
     946      (setf *code* (coerce *code* 'vector)))
     947    (when *compiler-debug*
     948      (sys::%format t "----- after optimization -----~%")
     949      (print-code *code*)))
     950  t)
     951
     952
     953
     954
    864955(defun code-bytes (code)
    865956  (let ((length 0)
Note: See TracChangeset for help on using the changeset viewer.