[armedbear-cvs] r11545 - trunk/abcl/src/org/armedbear/lisp
Ville Voutilainen
vvoutilainen at common-lisp.net
Sun Jan 4 22:21:07 UTC 2009
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
More information about the armedbear-cvs
mailing list