[armedbear-cvs] r12841 - branches/generic-class-file/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun Aug  1 05:59:11 2010
New Revision: 12841

Log:
Fix dual-mode: the new style requires type specifiers, not strings.

Modified:
   branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun Aug  1 05:59:11 2010
@@ -462,11 +462,10 @@
   (let* ((info (get-descriptor-info arg-types return-type))
          (descriptor (car info))
          (stack-effect (cdr info))
-         (class-name (!class-name class-name))
          (index (if (null *current-code-attribute*)
-                    (pool-method class-name method-name descriptor)
+                    (pool-method (!class-name class-name) method-name descriptor)
                     (pool-add-method-ref *pool* class-name
-                                         method-name descriptor)))
+                                         method-name (cons return-type arg-types))))
          (instruction (apply #'%emit 'invokestatic (u2 index))))
     (setf (instruction-stack instruction) stack-effect)))
 
@@ -488,11 +487,10 @@
   (let* ((info (get-descriptor-info arg-types return-type))
          (descriptor (car info))
          (stack-effect (cdr info))
-         (class-name (!class-name class-name))
          (index (if (null *current-code-attribute*)
-                    (pool-method class-name method-name descriptor)
+                    (pool-method (!class-name class-name) method-name descriptor)
                     (pool-add-method-ref *pool* class-name
-                                         method-name descriptor)))
+                                         method-name (cons return-type arg-types))))
          (instruction (apply #'%emit 'invokevirtual (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
     (let ((explain *explain*))
@@ -510,11 +508,10 @@
   (let* ((info (get-descriptor-info arg-types nil))
          (descriptor (car info))
          (stack-effect (cdr info))
-         (class-name (!class-name class-name))
          (index (if (null *current-code-attribute*)
-                    (pool-method class-name "<init>" descriptor)
+                    (pool-method (!class-name  class-name) "<init>" descriptor)
                     (pool-add-method-ref *pool* class-name
-                                         "<init>" descriptor)))
+                                         "<init>" (cons nil arg-types))))
          (instruction (apply #'%emit 'invokespecial (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
     (setf (instruction-stack instruction) (1- stack-effect))))