Changeset 8315


Ignore:
Timestamp:
12/30/04 21:54:43 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

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

    r8314 r8315  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.329 2004-12-30 18:29:32 piso Exp $
     4;;; $Id: jvm.lisp,v 1.330 2004-12-30 21:54:43 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    12061206  (let* ((code *code*)
    12071207         (code-length (length code)))
     1208    (declare (type fixnum code-length))
    12081209    (aver (vectorp code))
    12091210    (dotimes (i code-length)
     1211      (declare (type fixnum i))
    12101212      (let* ((instruction (aref code i))
    12111213             (opcode (instruction-opcode instruction)))
     
    12241226        (unless (instruction-stack instruction)
    12251227          (%format t "no stack information for instruction ~D~%" (instruction-opcode instruction))
    1226           (aver nil))
    1227         ))
     1228          (aver nil))))
    12281229    (walk-code code 0 0)
    12291230    (dolist (handler *handlers*)
     
    12321233    (let ((max-stack 0))
    12331234      (dotimes (i code-length)
     1235        (declare (type fixnum i))
    12341236        (let* ((instruction (aref code i))
    12351237               (depth (instruction-depth instruction)))
     
    25922594  (when (> *debug* *speed*)
    25932595    (return-from compile-funcall (compile-function-call form target representation)))
    2594 ;;   (let ((new-form (rewrite-function-call form)))
    2595 ;;     (when (neq new-form form)
    2596 ;;       (return-from compile-funcall (compile-form new-form :target target))))
    25972596  (compile-form (cadr form) :target :stack)
    25982597  (maybe-emit-clear-values (cadr form))
     
    28212820      (process-args args)
    28222821      (return-from compile-test-3 (if negatep 'if_acmpeq 'if_acmpne)))
    2823     (let ((first (first args))
    2824           (second (second args)))
    2825       (when (and (memq op '(< <= > >= = /=)) (fixnump second))
    2826         (let ((variable (unboxed-fixnum-variable first)))
    2827           (when variable
    2828             (dformat t "compile-test-3 unboxed fixnum constant comparison case~%")
    2829             (aver (variable-register variable))
    2830             (emit 'iload (variable-register variable))
    2831             (emit-push-constant-int second)
    2832             (case op
    2833               (<
    2834                (return-from compile-test-3 (if negatep 'if_icmplt 'if_icmpge)))
    2835               (<=
    2836                (return-from compile-test-3 (if negatep 'if_icmple 'if_icmpgt)))
    2837               (>
    2838                (return-from compile-test-3 (if negatep 'if_icmpgt 'if_icmple)))
    2839               (>=
    2840                (return-from compile-test-3 (if negatep 'if_icmpge 'if_icmplt)))
    2841               (=
    2842                (return-from compile-test-3 (if negatep 'if_icmpeq 'if_icmpne)))
    2843               (/=
    2844                (return-from compile-test-3 (if negatep 'if_icmpne 'if_icmpeq)))
    2845               )))
     2822    (let* ((arg1 (first args))
     2823           (arg2 (second args))
     2824           (var1 (unboxed-fixnum-variable arg1))
     2825           (var2 (unboxed-fixnum-variable arg2)))
     2826      (when (memq op '(< <= > >= = /=))
     2827        (when (and (arg-is-fixnum-p arg1)
     2828                   (arg-is-fixnum-p arg2))
     2829          (emit-push-int arg1)
     2830          (emit-push-int arg2)
     2831          (case op
     2832            (<
     2833             (return-from compile-test-3 (if negatep 'if_icmplt 'if_icmpge)))
     2834            (<=
     2835             (return-from compile-test-3 (if negatep 'if_icmple 'if_icmpgt)))
     2836            (>
     2837             (return-from compile-test-3 (if negatep 'if_icmpgt 'if_icmple)))
     2838            (>=
     2839             (return-from compile-test-3 (if negatep 'if_icmpge 'if_icmplt)))
     2840            (=
     2841             (return-from compile-test-3 (if negatep 'if_icmpeq 'if_icmpne)))
     2842            (/=
     2843             (return-from compile-test-3 (if negatep 'if_icmpne 'if_icmpeq)))
     2844            ))
    28462845
    28472846        ;; Otherwise...
    2848 ;;         (dformat t "compile-test-3 constant comparison case~%")
    2849         (compile-form first :target :stack)
    2850         (maybe-emit-clear-values first)
    2851         (emit-push-constant-int second)
    2852         (emit-invokevirtual +lisp-object-class+
    2853                             (case op
    2854                               (<  "isLessThan")
    2855                               (<= "isLessThanOrEqualTo")
    2856                               (>  "isGreaterThan")
    2857                               (>= "isGreaterThanOrEqualTo")
    2858                               (=  "isEqualTo")
    2859                               (/= "isNotEqualTo"))
    2860                             "(I)Z"
    2861                             -1)
    2862         (return-from compile-test-3 (if negatep 'ifne 'ifeq)))
     2847        (when (arg-is-fixnum-p arg2)
     2848          (compile-form arg1 :target :stack)
     2849          (maybe-emit-clear-values arg1)
     2850          (emit-push-int arg2)
     2851          (emit-invokevirtual +lisp-object-class+
     2852                              (case op
     2853                                (<  "isLessThan")
     2854                                (<= "isLessThanOrEqualTo")
     2855                                (>  "isGreaterThan")
     2856                                (>= "isGreaterThanOrEqualTo")
     2857                                (=  "isEqualTo")
     2858                                (/= "isNotEqualTo"))
     2859                              "(I)Z"
     2860                              -1)
     2861          (return-from compile-test-3 (if negatep 'ifne 'ifeq))))
    28632862
    28642863      (when (eq op '<)
    2865         (let ((variable (unboxed-fixnum-variable first)))
    2866           (when variable
    2867             (dformat t "compile-test-3 unboxed fixnum variable comparison case~%")
    2868             (aver (variable-register variable))
    2869             (emit 'iload (variable-register variable))
    2870             (compile-form second :target :stack)
     2864          (when var1
     2865            (dformat t "compile-test-3 unboxed fixnum var1 comparison case~%")
     2866            (aver (variable-register var1))
     2867            (emit 'iload (variable-register var1))
     2868            (compile-form arg2 :target :stack)
    28712869            (emit 'swap)
    28722870            (emit-invokevirtual +lisp-object-class+
     
    28742872                                "(I)Z"
    28752873                                -1)
    2876             (return-from compile-test-3 (if negatep 'ifne 'ifeq))))))
     2874            (return-from compile-test-3 (if negatep 'ifne 'ifeq)))))
    28772875
    28782876    (let ((s (cdr (assq op
     
    29202918  (when (and (consp form)
    29212919             (not (special-operator-p (car form))))
    2922 ;;     (let ((new-form (rewrite-function-call form)))
    2923 ;;       (when (neq new-form form)
    2924 ;;         (return-from compile-test (compile-test new-form negatep))))
    29252920    (case (length form)
    29262921      (2
     
    37093704
    37103705(defun compile-rplacd (form &key (target *val*) representation)
    3711 ;;   (let ((new-form (rewrite-function-call form)))
    3712 ;;     (when (neq new-form form)
    3713 ;;       (return-from compile-rplacd (compile-form new-form :target target))))
    37143706  (let ((args (cdr form)))
    37153707    (unless (= (length args) 2)
Note: See TracChangeset for help on using the changeset viewer.