[armedbear-cvs] r11611 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Jan 31 20:28:09 2009
New Revision: 11611

Log:
Clean up COMPILE-CONSTANT: there's no reason to cast from one type to another at runtime if you can do it compile time.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sat Jan 31 20:28:09 2009
@@ -2366,40 +2366,26 @@
   (case representation
     (:int
      (cond ((fixnump form)
-            (emit-push-constant-int form)
-            (emit-move-from-stack target representation)
-            (return-from compile-constant))
+            (emit-push-constant-int form))
            ((integerp form)
             (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+)
-            (emit-invokevirtual +lisp-object-class+ "intValue" nil "I")
-            (emit-move-from-stack target representation)
-            (return-from compile-constant))
+            (emit-invokevirtual +lisp-object-class+ "intValue" nil "I"))
            (t
             (sys::%format t "compile-constant int representation~%")
-            (assert nil))))
+            (assert nil)))
+     (emit-move-from-stack target representation)
+     (return-from compile-constant))
     (:long
-     (cond ((fixnump form)
-            (case form
-              (0
-               (emit 'lconst_0))
-              (1
-               (emit 'lconst_1))
-              (t
-               (emit-push-constant-int form)
-               (emit 'i2l)))
-            (emit-move-from-stack target representation)
-            (return-from compile-constant))
-           ((<= most-negative-java-long form most-positive-java-long)
-            (emit 'ldc2_w (pool-long form))
-            (return-from compile-constant))
+     (cond ((<= most-negative-java-long form most-positive-java-long)
+            (emit-push-constant-long form))
            ((integerp form)
             (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+)
-            (emit-invokevirtual +lisp-object-class+ "longValue" nil "J")
-            (emit-move-from-stack target representation)
-            (return-from compile-constant))
+            (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
            (t
             (sys::%format t "compile-constant long representation~%")
-            (assert nil))))
+            (assert nil)))
+     (emit-move-from-stack target representation)
+     (return-from compile-constant))
     (:char
      (cond ((characterp form)
             (emit-push-constant-int (char-code form))
@@ -2413,17 +2399,8 @@
      (emit-move-from-stack target representation)
      (return-from compile-constant))
     (:float
-     (cond ((fixnump form)
-            (compile-constant form 'stack :int)
-            (emit 'i2f))
-           ((and (integerp form)
-                 (<= most-negative-java-long form most-positive-java-long))
-            (compile-constant form 'stack :long)
-            (emit 'l2f))
-           ((integerp form)
-            (emit 'getfield *this-class* (declare-bignum form)
-                  +lisp-bignum+)
-            (emit-invokevirtual +lisp-bignum-class+ "floatValue" nil "F"))
+     (cond ((integerp form)
+            (emit-push-constant-float (coerce form 'single-float)))
            ((typep form 'single-float)
             (emit-push-constant-float form))
            ((typep form 'double-float)
@@ -2435,20 +2412,9 @@
      (emit-move-from-stack target representation)
      (return-from compile-constant))
     (:double
-     (cond ((fixnump form)
-            (compile-constant form 'stack :int)
-            (emit 'i2d))
-           ((and (integerp form)
-                 (<= most-negative-java-long form most-positive-java-long))
-            (compile-constant form 'stack :long)
-            (emit 'l2d))
-           ((integerp form)
-            (emit 'getfield *this-class* (declare-bignum form)
-                  +lisp-bignum+)
-            (emit-invokevirtual +lisp-bignum-class+ "doubleValue" nil "D"))
-           ((typep form 'single-float)
-            (emit-push-constant-float form)
-            (emit 'f2d))
+     (cond ((or (integerp form)
+                (typep form 'single-float))
+            (emit-push-constant-double (coerce form 'double-float)))
            ((typep form 'double-float)
             (emit-push-constant-double form))
            (t
@@ -6928,12 +6894,10 @@
               (emit-move-from-stack target representation))
              (t
               (compile-binary-operation "add" args target representation)))))
-    (4
-     ;; (+ a b c) => (+ (+ a b) c)
-     (let ((new-form `(+ (+ ,(second form) ,(third form)) ,(fourth form))))
-       (p2-plus new-form target representation)))
     (t
-     (compile-function-call form target representation))))
+     ;; (+ a b c) => (+ (+ a b) c)
+     (let ((new-form `(+ (+ ,(second form) ,(third form)) ,@(nthcdr 3 form))))
+       (p2-plus new-form target representation)))))
 
 (defun p2-minus (form target representation)
   (case (length form)