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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Jan 24 10:12:17 2009
New Revision: 11578

Log:
Miscelanious:
 - Merge [within p2-plus] (fixnum-type-p type2) case with (fixnum-type-p type1)
 - Add some cases handled by p2-plus to p2-minus too.
 - Fix parenthetical error

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 24 10:12:17 2009
@@ -2288,9 +2288,9 @@
                   +lisp-bignum+)
             (emit-invokevirtual +lisp-bignum-class+ "floatValue" nil "F"))
            ((typep form 'single-float)
-            (emit 'ldc (declare-float form)))
+            (emit 'ldc (pool-float form)))
            ((typep form 'double-float)
-            (emit 'ldc2_w (declare-double form))
+            (emit 'ldc2_w (pool-double form))
             (emit 'd2f))
            (t (assert nil)))
      (emit-move-from-stack target representation)
@@ -2306,15 +2306,15 @@
            ((integerp form)
             (emit 'getfield *this-class* (declare-bignum form)
                   +lisp-bignum+)
-            (emit-invokevirtual +lisp-bignum-class+ "doubleValue" nil "D")
+            (emit-invokevirtual +lisp-bignum-class+ "doubleValue" nil "D"))
            ((typep form 'single-float)
-            (emit 'ldc (declare-float form))
+            (emit 'ldc (pool-float form))
             (emit 'f2d))
            ((typep form 'double-float)
-            (emit 'ldc2_w (declare-double form)))
+            (emit 'ldc2_w (pool-double form)))
            (t (assert nil)))
      (emit-move-from-stack target representation)
-     (return-from compile-constant))))
+     (return-from compile-constant)))
   (cond ((fixnump form)
          (let ((translation (case form
                               (0  "ZERO")
@@ -6786,16 +6786,12 @@
              ((eql arg1 1)
 	      (compile-forms-and-maybe-emit-clear-values arg2 'stack nil)
               (emit-invoke-method "incr" target representation))
-             ((fixnum-type-p type1)
-	      (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
-							 arg2 'stack nil)
-              (emit 'swap)
-              (emit-invokevirtual +lisp-object-class+ "add" '("I") +lisp-object+)
-              (fix-boxing representation result-type)
-              (emit-move-from-stack target representation))
-             ((fixnum-type-p type2)
-	      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
-							 arg2 'stack :int)
+             ((or (fixnum-type-p type1) (fixnum-type-p type2))
+	      (compile-forms-and-maybe-emit-clear-values
+                    arg1 'stack (when (fixnum-type-p type1) :int)
+                    arg2 'stack (when (fixnum-type-p type2) :int))
+              (when (fixnum-type-p type1)
+                (emit 'swap))
               (emit-invokevirtual +lisp-object-class+ "add" '("I") +lisp-object+)
               (fix-boxing representation result-type)
               (emit-move-from-stack target representation))
@@ -6867,10 +6863,14 @@
               (emit 'lsub)
               (convert-long representation)
               (emit-move-from-stack target representation))
-             ((fixnum-type-p type2)
-	      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
-							 arg2 'stack :int)
-              (emit-invokevirtual +lisp-object-class+ "subtract" '("I") +lisp-object+)
+             ((or (fixnum-type-p type1) (fixnum-type-p type2))
+	      (compile-forms-and-maybe-emit-clear-values
+                    arg1 'stack (when (fixnum-type-p type1) :int)
+                    arg2 'stack (when (fixnum-type-p type2) :int))
+              (when (fixnum-type-p type1)
+                (emit 'swap))
+              (emit-invokevirtual +lisp-object-class+ "subtract"
+                                  '("I") +lisp-object+)
               (fix-boxing representation result-type)
               (emit-move-from-stack target representation))
              (t