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

[Ville Voutilainen]

Author: vvoutilainen
Date: Sun Jan  4 22:21:07 2009
New Revision: 11545

Log:
Another small helper for p2-plus/minus.


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	Sun Jan  4 22:21:07 2009
@@ -6586,6 +6586,20 @@
          (t
           (compile-function-call form target representation))))
 
+(defun fixnum-result-plus/minus (target representation result-type arg1 arg2
+				 int-op long-op)
+  (cond ((or (eq representation :int)
+	     (fixnum-type-p result-type))
+	 (new-fixnum (null representation))
+	 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
+						    arg2 'stack :int)
+	 (emit int-op)
+	 (emit-fixnum-init representation))
+	(t
+	 (two-long-ints-times/plus/minus 
+	  arg1 arg2 long-op representation)))
+  (emit-move-from-stack target representation))
+
 (defun p2-plus (form target representation)
   (case (length form)
     (3
@@ -6613,17 +6627,8 @@
 							 arg2 nil nil)
               (emit-move-from-stack target representation))
              ((and (fixnum-type-p type1) (fixnum-type-p type2))
-              (cond ((or (eq representation :int)
-                         (fixnum-type-p result-type))
-		     (new-fixnum (null representation))
-		     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
-								arg2 'stack :int)
-                     (emit 'iadd)
-		     (emit-fixnum-init representation))
-                    (t
-		     (two-long-ints-times/plus/minus 
-		      arg1 arg2 'ladd representation)))
-              (emit-move-from-stack target representation))
+	      (fixnum-result-plus/minus target representation result-type 
+					arg1 arg2 'iadd 'ladd))
              ((and (java-long-type-p type1)
                    (java-long-type-p type2)
                    (java-long-type-p result-type))
@@ -6719,17 +6724,8 @@
        (cond ((and (numberp arg1) (numberp arg2))
               (compile-constant (- arg1 arg2) target representation))
              ((and (fixnum-type-p type1) (fixnum-type-p type2))
-              (cond ((or (eq representation :int)
-                         (fixnum-type-p result-type))
-		     (new-fixnum (null representation))
-		     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
-								arg2 'stack :int)
-                     (emit 'isub)
-		     (emit-fixnum-init representation))
-                    (t
-		     (two-long-ints-times/plus/minus 
-		      arg1 arg2 'lsub representation)))
-              (emit-move-from-stack target representation))
+	      (fixnum-result-plus/minus target representation result-type 
+					arg1 arg2 'isub 'lsub))
              ((and (java-long-type-p type1) (java-long-type-p type2)
                    (java-long-type-p result-type))
 	      (compile-forms-and-maybe-emit-clear-values arg1 'stack :long