Changeset 12875
- Timestamp:
- 08/07/10 21:14:06 (13 years ago)
- 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 919 919 920 920 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-instruction928 (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 ; LABEL933 (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-instruction938 (instruction-opcode next-instruction))))939 (case this-opcode940 (205 ; CLEAR-VALUES941 (when (eql next-opcode 205) ; CLEAR-VALUES942 (setf (aref code i) nil)943 (setf changed t)))944 (178 ; GETSTATIC945 (when (and (eql next-opcode 87) ; POP946 (not labels-skipped-p))947 (setf (aref code i) nil)948 (setf (aref code (1+ i)) nil)949 (setf changed t)))950 (176 ; ARETURN951 (when (eql next-opcode 176) ; ARETURN952 (setf (aref code i) nil)953 (setf changed t)))954 ((200 167) ; GOTO GOTO_W955 (when (and (or (eql next-opcode 202) ; LABEL956 (eql next-opcode 200) ; GOTO_W957 (eql next-opcode 167)) ; GOTO958 (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 (loop976 (let ((changed-p nil))977 (multiple-value-setq978 (*code* changed-p)979 (delete-unused-labels *code*980 (nconc981 (mapcar #'handler-from *handlers*)982 (mapcar #'handler-to *handlers*)983 (mapcar #'handler-code *handlers*))))984 (if changed-p985 (setf *code* (optimize-instruction-sequences *code*))986 (multiple-value-setq987 (*code* changed-p)988 (optimize-instruction-sequences *code*)))989 (if changed-p990 (setf *code* (optimize-jumps *code*))991 (multiple-value-setq992 (*code* changed-p)993 (optimize-jumps *code*)))994 (if changed-p995 (setf *code* (delete-unreachable-code *code*))996 (multiple-value-setq997 (*code* changed-p)998 (delete-unreachable-code *code*)))999 (unless changed-p1000 (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)1007 921 1008 922 -
branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp
r12873 r12875 862 862 (values code changed))) 863 863 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 864 955 (defun code-bytes (code) 865 956 (let ((length 0)
Note: See TracChangeset
for help on using the changeset viewer.