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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Feb  6 23:01:59 2009
New Revision: 11636

Log:
Generalize code generation paths for :INT/:LONG representations in P2-MIN/MAX into 1 path.

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	Fri Feb  6 23:01:59 2009
@@ -3193,6 +3193,16 @@
 given a specific common representation.")
 
 
+(defun emit-numeric-comparison (op representation false-LABEL)
+  (let* ((pos (position op comparison-ops))
+         (ops-table (cdr (assoc representation comparison-ins)))
+         (ops (aref ops-table pos)))
+    (if (listp ops)
+        (progn
+          (emit (car ops))
+          (emit (cadr ops) false-LABEL))
+        (emit ops false-LABEL))))
+
 ;; Note that /= is not transitive, so we don't handle it here.
 (defknown p2-numeric-comparison (t t t) t)
 (defun p2-numeric-comparison (form target representation)
@@ -3220,14 +3230,7 @@
 		  (compile-forms-and-maybe-emit-clear-values
                           arg1 'stack common-rep
                           arg2 'stack common-rep)
-                  (let* ((pos (position op comparison-ops))
-                         (ops-table (cdr (assoc common-rep comparison-ins)))
-                         (ops (aref ops-table pos)))
-                    (if (listp ops)
-                        (progn
-                          (emit (car ops))
-                          (emit (cadr ops) LABEL1))
-                        (emit ops LABEL1)))
+                  (emit-numeric-comparison op common-rep LABEL1)
                   (emit-push-true representation)
                   (emit 'goto LABEL2)
                   (label LABEL1)
@@ -6756,32 +6759,23 @@
            (return-from p2-min/max))
          (let ((type1 (derive-compiler-type arg1))
                (type2 (derive-compiler-type arg2)))
-           (cond ((and (fixnum-type-p type1) (fixnum-type-p type2))
-                  (compile-form arg1 'stack :int)
-                  (emit 'dup)
-                  (compile-form arg2 'stack :int)
-                  (emit 'dup_x1)
-                  (let ((LABEL1 (gensym)))
-                    (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1)
-                    (emit 'swap)  ;; The lower stack value is greater-or-equal
+           (cond ((and (java-long-type-p type1) (java-long-type-p type2))
+                  (let ((common-rep (if (and (fixnum-type-p type1)
+                                             (fixnum-type-p type2))
+                                        :int :long))
+                        (LABEL1 (gensym)))
+                    (compile-form arg1 'stack common-rep)
+                    (emit-dup common-rep)
+                    (compile-form arg2 'stack common-rep)
+                    (emit (if (eq common-rep :long)
+                              'dup2_x2 'dup_x1))
+                    (emit-numeric-comparison (if (eq op 'max) '<= '>=)
+                                             common-rep LABEL1)
+                    (emit-swap common-rep common-rep)
                     (label LABEL1)
-                    (emit 'pop))  ;; Throw away the lower stack value
-                  (convert-representation :int representation)
-                  (emit-move-from-stack target representation))
-                 ((and (java-long-type-p type1) (java-long-type-p type2))
-                  (compile-form arg1 'stack :long)
-                  (emit 'dup2)
-                  (compile-form arg2 'stack :long)
-                  (emit 'dup2_x2)
-                  (emit 'lcmp)
-                  (let ((LABEL1 (gensym)))
-                    (emit (if (eq op 'max) 'ifge 'ifle) LABEL1)
-                    (emit 'dup2_x2) ;; pour-mans swap2
-                    (emit 'pop2)
-                    (label LABEL1)
-                    (emit 'pop2))
-                  (convert-representation :long representation)
-                  (emit-move-from-stack target representation))
+                    (emit-move-from-stack nil common-rep)
+                    (convert-representation common-rep representation)
+                    (emit-move-from-stack target representation)))
                  (t
                   (compile-form arg1 'stack nil)
                   (emit 'dup)