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

Erik Huelsmann ehuelsmann at common-lisp.net
Sun Jul 4 07:49:15 UTC 2010


Author: ehuelsmann
Date: Sun Jul  4 03:49:14 2010
New Revision: 12781

Log:
Small fixes found by test-writing.

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

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Sun Jul  4 03:49:14 2010
@@ -153,17 +153,17 @@
 |#
 
 (defun internal-field-type (field-type)
-  (if (keywordp field-type)
+  (if (symbolp field-type)
       (map-primitive-type field-type)
       (class-name-internal field-type)))
 
 (defun internal-field-ref (field-type)
-  (if (keywordp field-type)
+  (if (symbolp field-type)
       (map-primitive-type field-type)
       (class-ref field-type)))
 
 (defun descriptor (return-type &rest argument-types)
-  (format nil "(~{~A~}~A)" (mapcar #'internal-field-ref argument-types)
+  (format nil "(~{~A~})~A" (mapcar #'internal-field-ref argument-types)
           (internal-field-type return-type)))
 
 
@@ -401,7 +401,7 @@
              (class-file-methods class))))
 
 (defun class-add-attribute (class attribute)
-  (push atttribute (class-file-attributes class)))
+  (push attribute (class-file-attributes class)))
 
 (defun class-attribute (class name)
   (find name (class-file-attributes class)
@@ -415,8 +415,8 @@
 
   (setf (class-file-access-flags class)
         (map-flags (class-file-access-flags class)))
-  (setf (class-file-class-name class)
-        (pool-add-class (class-name-internal (class-file-class-name class))))
+  (setf (class-file-class class)
+        (pool-add-class (class-name-internal (class-file-class class))))
   ;;  (finalize-interfaces)
   (dolist (field (class-file-fields class))
     (finalize-field field class))
@@ -582,7 +582,7 @@
 (defun method-add-code (method)
   "Creates an (empty) 'Code' attribute for the method."
   (method-add-attribute
-   (make-code-attribute (+ (length args)
+   (make-code-attribute (+ (length (cdr (method-descriptor method)))
                            (if (member :static (method-access-flags method))
                                0 1))))) ;; 1 == implicit 'this'
 




More information about the armedbear-cvs mailing list