Changeset 13739


Ignore:
Timestamp:
01/09/12 22:55:37 (9 years ago)
Author:
astalla
Message:

Annotations in class-file:

  • support for enum-value elements;
  • rectified boolean valued elements (Z instead of B which is Byte)
Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r13727 r13739  
    8282
    8383(defstruct (jvm-class-name (:conc-name class-)
    84          (:constructor %make-jvm-class-name))
     84                           (:constructor %make-jvm-class-name))
    8585  "Used for class identification.
    8686
     
    374374  "Returns the index of the constant-pool class item for `class'.
    375375
    376 `class' must be an instance of `class-name'."
    377   (let ((entry (gethash class (pool-entries pool))))
    378     (unless entry
    379       (let ((utf8 (pool-add-utf8 pool (class-name-internal class))))
    380         (setf entry
    381               (make-constant-class (incf (pool-index pool)) utf8)
    382               (gethash class (pool-entries pool)) entry))
    383       (push entry (pool-entries-list pool)))
    384     (constant-index entry)))
     376`class' must be an instance of `class-name' or a string (which will be converted
     377to a `class-name')."
     378  (let ((class (if (jvm-class-name-p class)
     379                   class
     380                   (make-jvm-class-name class))))
     381    (let ((entry (gethash class (pool-entries pool))))
     382      (unless entry
     383        (let ((utf8 (pool-add-utf8 pool (class-name-internal class))))
     384          (setf entry
     385                (make-constant-class (incf (pool-index pool)) utf8)
     386                (gethash class (pool-entries pool)) entry))
     387        (push entry (pool-entries-list pool)))
     388      (constant-index entry))))
    385389
    386390(defun pool-add-field-ref (pool class name type)
     
    13491353  elements)
    13501354
    1351 (defstruct annotation-element name value)
     1355(defstruct annotation-element (name "value") value)
    13521356
    13531357(defstruct annotation-element-value tag finalizer writer)
     
    13611365                                        (boolean
    13621366                                         (setf (annotation-element-value-tag self)
    1363                                                (char-code #\B)
     1367                                               (char-code #\Z)
    13641368                                               (primitive-or-string-annotation-element-value self)
    1365                                                (pool-add-int (class-file-constants class) (if value 1 0))))))))
     1369                                               (pool-add-int (class-file-constants class) (if value 1 0))))
     1370                                        (fixnum
     1371                                         (setf (annotation-element-value-tag self)
     1372                                               (char-code #\I)
     1373                                               (primitive-or-string-annotation-element-value self)
     1374                                               (pool-add-int (class-file-constants class) value)))
     1375                                        (string
     1376                                         (setf (annotation-element-value-tag self)
     1377                                               (char-code #\s)
     1378                                               (primitive-or-string-annotation-element-value self)
     1379                                               (pool-add-utf8 (class-file-constants class) value)))))))
    13661380                       (writer (lambda (self stream)
    13671381                                 (write-u1 (annotation-element-value-tag self) stream)
     
    13691383  value)
    13701384
     1385(defstruct (enum-value-annotation-element-value
     1386             (:conc-name enum-value-annotation-element-)
     1387             (:include annotation-element-value
     1388                       (finalizer (lambda (self class)
     1389                                    (setf (annotation-element-value-tag self)
     1390                                          (char-code #\e)
     1391                                          (enum-value-annotation-element-type self)
     1392                                          (pool-add-utf8 (class-file-constants class)
     1393                                                         (enum-value-annotation-element-type self)) ;;Binary name as string
     1394                                          (enum-value-annotation-element-name self)
     1395                                          (pool-add-utf8 (class-file-constants class)
     1396                                                         (enum-value-annotation-element-name self)))))
     1397                       (writer (lambda (self stream)
     1398                                 (write-u1 (annotation-element-value-tag self) stream)
     1399                                 (write-u2 (enum-value-annotation-element-type self) stream)
     1400                                 (write-u2 (enum-value-annotation-element-name self) stream)))))
     1401  type
     1402  name)
     1403
    13711404(defstruct (runtime-visible-annotations-attribute
    13721405             (:include annotations-attribute
    1373                        (name "RuntimeVisibleAnnotations")
    1374                        (finalizer #'finalize-annotations)
    1375                        (writer #'write-annotations)))
     1406                       (name "RuntimeVisibleAnnotations")))
    13761407  "4.8.15 The RuntimeVisibleAnnotations attribute
    13771408The RuntimeVisibleAnnotations attribute is a variable length attribute in the
     
    13891420  (dolist (ann (annotations-list annotations))
    13901421    (setf (annotation-type ann)
    1391           (pool-add-class (class-file-constants class)
    1392                           (if (jvm-class-name-p (annotation-type ann))
    1393                               (annotation-type ann)
    1394                               (make-jvm-class-name (annotation-type ann)))))
     1422          (pool-add-class (class-file-constants class) (annotation-type ann)))
    13951423    (dolist (elem (annotation-elements ann))
    13961424      (setf (annotation-element-name elem)
     
    14061434    (write-u2 (length (annotation-elements annotation)) stream)
    14071435    (dolist (elem (reverse (annotation-elements annotation)))
    1408       (funcall (annotation-element-value-writer elem) elem stream))))
     1436      (write-u2 (annotation-element-name elem) stream)
     1437      (funcall (annotation-element-value-writer (annotation-element-value elem))
     1438               (annotation-element-value elem) stream))))
    14091439
    14101440#|
  • trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp

    r13727 r13739  
    22(require "JVM-CLASS-FILE")
    33
     4;;The package is set to :jvm for convenience, since most of the symbols used
     5;;here come from that package. However, the functions we're definining belong
     6;;to the :java package.
    47(in-package :jvm)
    58
     
    139142           (list "foo" :void '("java.lang.Object")
    140143                 (lambda (this that) (print (list this that)))
    141                  :annotations (list (make-annotation :type "java.lang.Deprecated")))
     144                 :annotations (list (make-annotation :type "java.lang.Deprecated")
     145                                    (make-annotation :type "java.lang.annotation.Retention"
     146                                                     :elements (list (make-annotation-element
     147                                                                      :value (make-enum-value-annotation-element-value
     148                                                                              :type "java.lang.annotation.RetentionPolicy"
     149                                                                              :name "RUNTIME"))))
     150                                    (make-annotation :type "javax.xml.bind.annotation.XmlAttribute"
     151                                                     :elements (list (make-annotation-element
     152                                                                      :name "required"
     153                                                                      :value (make-primitive-or-string-annotation-element-value :value t))))))
    142154           (list "bar" :int '("java.lang.Object")
    143155                 (lambda (this that) (print (list this that)) 23))))
Note: See TracChangeset for help on using the changeset viewer.