Ignore:
Timestamp:
01/07/12 23:09:30 (10 years ago)
Author:
astalla
Message:

Class writer: basic support for annotations (only without parameters)
Runtime-class: annotations on methods only, with no syntax sugar yet

File:
1 edited

Legend:

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

    r13710 r13727  
    11(require "COMPILER-PASS2")
     2(require "JVM-CLASS-FILE")
    23
    34(in-package :jvm)
     
    2627
    2728   Method definitions are lists of the form
    28    (method-name return-type argument-types function modifier*)
     29   (method-name return-type argument-types function &key modifiers annotations)
    2930   where method-name is a string, return-type and argument-types are strings or keywords for
    3031   primitive types (:void, :int, etc.), and function is a Lisp function of minimum arity
    31    (1+ (length argument-types)); the instance (`this') is passed in as the last argument.
     32   (1+ (length argument-types)); the instance (`this') is passed in as the first argument.
    3233
    3334   Field definitions are lists of the form
     
    4546          (mapcar #'make-jvm-class-name interfaces))
    4647    (dolist (m methods)
    47       (destructuring-bind (name return-type argument-types function &rest flags) m
    48           (let* ((argument-types (mapcar #'make-jvm-class-name argument-types))
    49                  (argc (length argument-types))
    50                  (return-type (if (keywordp return-type)
    51                                   return-type
    52                                   (make-jvm-class-name return-type)))
    53                  (jmethod (make-jvm-method name return-type argument-types :flags (or flags '(:public))))
    54                  (field-name (string (gensym name))))
    55             (class-add-method class-file jmethod)
    56             (let ((field (make-field field-name +lisp-object+ :flags '(:public :static))))
    57               (class-add-field class-file field)
    58               (push (cons field-name function) method-implementation-fields))
    59             (with-code-to-method (class-file jmethod)
    60               ;;Allocate registers (2 * argc to load and store arguments + 2 to box "this")
    61               (dotimes (i (* 2 (1+ argc)))
    62                 (allocate-register nil))
    63               ;;Box "this" (to be passed as the first argument to the Lisp function)
    64               (aload 0)
    65               (emit 'iconst_1) ;;true
    66               (emit-invokestatic +abcl-java-object+ "getInstance"
    67                                              (list +java-object+ :boolean) +lisp-object+)
    68               (astore (1+ argc))
    69               ;;Box each argument
    70               (loop
    71                  :for arg-type :in argument-types
    72                  :for i :from 1
    73                  :do (progn
    74                        (cond
    75                          ((keywordp arg-type)
    76                           (error "Unsupported arg-type: ~A" arg-type))
    77                          ((eq arg-type :int) :todo)
    78                          (t (aload i)
    79                             (emit 'iconst_1) ;;true
    80                             (emit-invokestatic +abcl-java-object+ "getInstance"
    81                                                (list +java-object+ :boolean) +lisp-object+)))
    82                        (astore (+ i (1+ argc)))))
    83               ;;Load the Lisp function from its static field
    84               (emit-getstatic jvm-class-name field-name +lisp-object+)
    85               (if (<= (1+ argc) call-registers-limit)
    86                   (progn
    87                     ;;Load the boxed this
    88                     (aload (1+ argc))
    89                     ;;Load each boxed argument
    90                     (dotimes (i argc)
    91                       (aload (+ argc 2 i))))
    92                   (error "execute(LispObject[]) is currently not supported"))
    93               (emit-call-execute (1+ (length argument-types)))
    94               (cond
    95                 ((eq return-type :void)
    96                  (emit 'pop)
    97                  (emit 'return))
    98                 ((eq return-type :int)
    99                  (emit-invokevirtual +lisp-object+ "intValue" nil :int)
    100                  (emit 'ireturn))
    101                 ((keywordp return-type)
    102                  (error "Unsupported return type: ~A" return-type))
    103                 (t
    104                  (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
    105                  (emit-checkcast return-type)
    106                  (emit 'areturn)))))))
     48      (destructuring-bind (name return-type argument-types function &key (modifiers '(:public)) annotations) m
     49        (let* ((argument-types (mapcar #'make-jvm-class-name argument-types))
     50               (argc (length argument-types))
     51               (return-type (if (keywordp return-type)
     52                                return-type
     53                                (make-jvm-class-name return-type)))
     54               (jmethod (make-jvm-method name return-type argument-types :flags modifiers))
     55               (field-name (string (gensym name))))
     56          (class-add-method class-file jmethod)
     57          (let ((field (make-field field-name +lisp-object+ :flags '(:public :static))))
     58            (class-add-field class-file field)
     59            (push (cons field-name function) method-implementation-fields))
     60          (when annotations
     61            (method-add-attribute jmethod (make-runtime-visible-annotations-attribute
     62                                           :list (mapcar #'parse-annotation annotations))))
     63          (with-code-to-method (class-file jmethod)
     64            ;;Allocate registers (2 * argc to load and store arguments + 2 to box "this")
     65            (dotimes (i (* 2 (1+ argc)))
     66              (allocate-register nil))
     67            ;;Box "this" (to be passed as the first argument to the Lisp function)
     68            (aload 0)
     69            (emit 'iconst_1) ;;true
     70            (emit-invokestatic +abcl-java-object+ "getInstance"
     71                               (list +java-object+ :boolean) +lisp-object+)
     72            (astore (1+ argc))
     73            ;;Box each argument
     74            (loop
     75               :for arg-type :in argument-types
     76               :for i :from 1
     77               :do (progn
     78                     (cond
     79                       ((keywordp arg-type)
     80                        (error "Unsupported arg-type: ~A" arg-type))
     81                       ((eq arg-type :int) :todo)
     82                       (t (aload i)
     83                          (emit 'iconst_1) ;;true
     84                          (emit-invokestatic +abcl-java-object+ "getInstance"
     85                                             (list +java-object+ :boolean) +lisp-object+)))
     86                     (astore (+ i (1+ argc)))))
     87            ;;Load the Lisp function from its static field
     88            (emit-getstatic jvm-class-name field-name +lisp-object+)
     89            (if (<= (1+ argc) call-registers-limit)
     90                (progn
     91                  ;;Load the boxed this
     92                  (aload (1+ argc))
     93                  ;;Load each boxed argument
     94                  (dotimes (i argc)
     95                    (aload (+ argc 2 i))))
     96                (error "execute(LispObject[]) is currently not supported"))
     97            (emit-call-execute (1+ (length argument-types)))
     98            (cond
     99              ((eq return-type :void)
     100               (emit 'pop)
     101               (emit 'return))
     102              ((eq return-type :int)
     103               (emit-invokevirtual +lisp-object+ "intValue" nil :int)
     104               (emit 'ireturn))
     105              ((jvm-class-name-p return-type)
     106               (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
     107               (emit-checkcast return-type)
     108               (emit 'areturn))
     109              (t
     110               (error "Unsupported return type: ~A" return-type)))))))
    107111    (when (null constructors)
    108112      (let ((ctor (make-jvm-method :constructor :void nil :flags '(:public))))
     
    125129      jclass)))
    126130
     131(defun parse-annotation (annotation)
     132  annotation) ;;TODO
     133
    127134#+example
    128135(java:jnew-runtime-class
     
    131138 :methods (list
    132139           (list "foo" :void '("java.lang.Object")
    133                  (lambda (this that) (print (list this that))))
     140                 (lambda (this that) (print (list this that)))
     141                 :annotations (list (make-annotation :type "java.lang.Deprecated")))
    134142           (list "bar" :int '("java.lang.Object")
    135143                 (lambda (this that) (print (list this that)) 23))))
Note: See TracChangeset for help on using the changeset viewer.