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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Feb  6 21:00:45 2009
New Revision: 11634

Log:
Better in-lining compilation of MIN and MAX.

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 21:00:45 2009
@@ -6740,65 +6740,68 @@
 
 (defknown p2-min/max (t t t) t)
 (defun p2-min/max (form target representation)
-  (cond ((= (length form) 3)
-         (let* ((op (%car form))
-                (args (%cdr form))
-                (arg1 (%car args))
-                (arg2 (%cadr args)))
-           (when (null target)
-	     (compile-forms-and-maybe-emit-clear-values arg1 nil nil
-							arg2 nil nil)
-             (return-from p2-min/max))
-           (when (notinline-p op)
-             (compile-function-call form target representation)
-             (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
-                      (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))
-                   (t
-                    (compile-form arg1 'stack nil)
-                    (emit 'dup)
-                    (compile-form arg2 'stack nil)
-                    (emit 'dup_x1)
-                    (emit-invokevirtual +lisp-object-class+
-                                        (if (eq op 'max)
-                                            "isLessThanOrEqualTo"
-                                            "isGreaterThanOrEqualTo")
-                                        (lisp-object-arg-types 1) "Z")
-                    (let ((LABEL1 (gensym)))
-                      (emit 'ifeq LABEL1)
-                      (emit 'swap)
-                      (label LABEL1)
-                      (emit 'pop))
-                    (fix-boxing representation nil)
-                    (emit-move-from-stack target representation))))))
-         (t
-          (compile-function-call form target representation))))
+  (case (length form)
+    (1 (error 'program-error "Wrong number of arguments for ~A." (car form)))
+    (2 (compile-form (cadr form) target representation))
+    (3 (let* ((op (%car form))
+              (args (%cdr form))
+              (arg1 (%car args))
+              (arg2 (%cadr args)))
+         (when (null target)
+           (compile-forms-and-maybe-emit-clear-values arg1 nil nil
+                                                      arg2 nil nil)
+           (return-from p2-min/max))
+         (when (notinline-p op)
+           (compile-function-call form target representation)
+           (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
+                    (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))
+                 (t
+                  (compile-form arg1 'stack nil)
+                  (emit 'dup)
+                  (compile-form arg2 'stack nil)
+                  (emit 'dup_x1)
+                  (emit-invokevirtual +lisp-object-class+
+                                      (if (eq op 'max)
+                                          "isLessThanOrEqualTo"
+                                          "isGreaterThanOrEqualTo")
+                                      (lisp-object-arg-types 1) "Z")
+                  (let ((LABEL1 (gensym)))
+                    (emit 'ifeq LABEL1)
+                    (emit 'swap)
+                    (label LABEL1)
+                    (emit 'pop))
+                  (fix-boxing representation nil)
+                  (emit-move-from-stack target representation))))))
+    (t
+     (p2-min/max `(,(car form) (,(car form) (second form) (third form))
+                    ,@(nthcdr 3 form)) target representation))))
 
 (defun p2-plus (form target representation)
   (case (length form)