Changeset 4770


Ignore:
Timestamp:
11/15/03 18:23:12 (18 years ago)
Author:
piso
Message:

OPTIMIZE-CODE: work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r4769 r4770  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.29 2003-11-15 16:15:44 piso Exp $
     4;;; $Id: jvm.lisp,v 1.30 2003-11-15 18:23:12 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2323
    2424(shadow 'method)
     25
     26(defvar *debug* nil)
    2527
    2628(defvar *instructions*
     
    743745  (setf *code* (nreverse (coerce *code* 'vector))))
    744746
    745 (defun optimize-code ()
     747(defun print-code()
    746748  (dotimes (i (length *code*))
    747749    (let ((instruction (svref *code* i)))
    748       (when (and (< i (1- (length *code*)))
    749                  (= (instruction-opcode instruction) 167) ; GOTO
    750                  (let ((next-instruction (svref *code* (1+ i))))
    751                    (when (and (= (instruction-opcode next-instruction) 202) ; LABEL
    752                               (eq (car (instruction-args instruction))
    753                                   (car (instruction-args next-instruction))))
    754                      (setf (instruction-opcode instruction) 0)))))))
    755 
    756   (setf *code* (delete 0 *code* :key #'instruction-opcode))
    757   )
     750      (format t "~A ~S~%"
     751              (instr (instruction-opcode instruction))
     752              (instruction-args instruction)))))
     753
     754(defun optimize-code ()
     755  (when *debug*
     756    (format t "----- before optimization -----~%")
     757    (print-code))
     758  (loop
     759    (let ((changed-p nil))
     760      ;; Make a list of the labels that are actually branched to.
     761      (let ((branch-targets ()))
     762        (dotimes (i (length *code*))
     763          (let ((instruction (svref *code* i)))
     764            (when (branch-opcode-p (instruction-opcode instruction))
     765              (push (car (instruction-args instruction)) branch-targets))))
     766;;         (format t "branch-targets = ~S~%" branch-targets)
     767        ;; Remove labels that are not used as branch targets.
     768        (dotimes (i (length *code*))
     769          (let ((instruction (svref *code* i)))
     770            (when (= (instruction-opcode instruction) 202) ; LABEL
     771              (let ((label (car (instruction-args instruction))))
     772                (unless (member label branch-targets)
     773                  (setf (instruction-opcode instruction) 0)'
     774                  (setf changed-p t)))))))
     775      (setf *code* (delete 0 *code* :key #'instruction-opcode))
     776      (dotimes (i (length *code*))
     777        (let ((instruction (svref *code* i)))
     778          (when (and (< i (1- (length *code*)))
     779                     (= (instruction-opcode instruction) 167) ; GOTO
     780                     (let ((next-instruction (svref *code* (1+ i))))
     781                       (cond ((and (= (instruction-opcode next-instruction) 202) ; LABEL
     782                                   (eq (car (instruction-args instruction))
     783                                       (car (instruction-args next-instruction))))
     784                              (setf (instruction-opcode instruction) 0)
     785                              (setf changed-p t))
     786                             ((= (instruction-opcode next-instruction) 167) ; GOTO
     787                              ;; One GOTO right after another.
     788                              (setf (instruction-opcode next-instruction) 0)
     789                              (setf changed-p t))
     790                              ))))))
     791      (setf *code* (delete 0 *code* :key #'instruction-opcode))
     792      (unless changed-p
     793          (return))))
     794  (when *debug*
     795    (format t "----- after optimization -----~%")
     796    (print-code)))
    758797
    759798(defvar *max-stack*)
Note: See TracChangeset for help on using the changeset viewer.