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

[Ville Voutilainen]

Author: vvoutilainen
Date: Mon Dec 22 12:15:22 2008
New Revision: 11469

Log:
Combine ifne instruction generation into a helper
function for p2-eql.


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	Mon Dec 22 12:15:22 2008
@@ -2388,6 +2388,20 @@
      (emit-move-from-stack target representation))
    t)
 
+(defun emit-ifne-for-eql (representation instruction-type)
+  (emit-invokevirtual +lisp-object-class+ "eql" instruction-type "Z")
+  (case representation
+    (:boolean)
+    (t
+     (let ((label1 (gensym))
+	   (label2 (gensym)))
+       (emit 'ifne `,label1)
+       (emit-push-nil)
+       (emit 'goto `,label2)
+       (emit 'label `,label1)
+       (emit-push-t)
+       (emit 'label `,label2)))))
+
 (defknown p2-eql (t t t) t)
 (defun p2-eql (form target representation)
   (aver (or (null representation) (eq representation :boolean)))
@@ -2413,65 +2427,21 @@
           ((fixnum-type-p type2)
 	   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
 						      arg2 'stack :int)
-           (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
-           (case representation
-             (:boolean)
-             (t
-              (let ((label1 (gensym))
-                    (label2 (gensym)))
-                (emit 'ifne `,label1)
-                (emit-push-nil)
-                (emit 'goto `,label2)
-                (emit 'label `,label1)
-                (emit-push-t)
-                (emit 'label `,label2)))))
+	   (emit-ifne-for-eql representation '("I")))
           ((fixnum-type-p type1)
 	   (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
 						      arg2 'stack nil)
            (emit 'swap)
-           (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
-           (case representation
-             (:boolean)
-             (t
-              (let ((label1 (gensym))
-                    (label2 (gensym)))
-                (emit 'ifne `,label1)
-                (emit-push-nil)
-                (emit 'goto `,label2)
-                (emit 'label `,label1)
-                (emit-push-t)
-                (emit 'label `,label2)))))
+	   (emit-ifne-for-eql representation '("I")))
           ((eq type2 'CHARACTER)
 	   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
 						      arg2 'stack :char)
-           (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
-           (case representation
-             (:boolean)
-             (t
-              (let ((label1 (gensym))
-                    (label2 (gensym)))
-                (emit 'ifne `,label1)
-                (emit-push-nil)
-                (emit 'goto `,label2)
-                (emit 'label `,label1)
-                (emit-push-t)
-                (emit 'label `,label2)))))
+	   (emit-ifne-for-eql representation '("C")))
           ((eq type1 'CHARACTER)
 	   (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
 						      arg2 'stack nil)
            (emit 'swap)
-           (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
-           (case representation
-             (:boolean)
-             (t
-              (let ((label1 (gensym))
-                    (label2 (gensym)))
-                (emit 'ifne `,label1)
-                (emit-push-nil)
-                (emit 'goto `,label2)
-                (emit 'label `,label1)
-                (emit-push-t)
-                (emit 'label `,label2)))))
+	   (emit-ifne-for-eql representation '("C")))
           (t
 	   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
 						      arg2 'stack nil)