Ignore:
Timestamp:
06/22/12 19:58:02 (9 years ago)
Author:
astalla
Message:

runtime-class: basic support for calling superclass methods (only with the same signature and only defined in the direct superclass)

File:
1 edited

Legend:

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

    r13920 r13981  
    8383    (format nil "~A~A~A" prefix initial rest)))
    8484
     85;;This is missing from compiler-pass2.lisp. Probably this and similar functions should reside
     86;;in a dedicated file, independent from both runtime-class and compiler-pass2.
     87(defun emit-invokespecial (class-name method-name arg-types return-type)
     88  (let* ((stack-effect (apply #'descriptor-stack-effect return-type arg-types))
     89         (index (pool-add-method-ref *pool* class-name
     90                                     method-name (cons return-type arg-types)))
     91         (instruction (apply #'%emit 'invokespecial (u2 index))))
     92    (declare (type (signed-byte 8) stack-effect))
     93    (setf (instruction-stack instruction) (1- stack-effect))))
     94
     95(defun java::canonicalize-java-type (type)
     96  (cond
     97    ((stringp type) (make-jvm-class-name type))
     98    ((keywordp type) type)
     99    (t (error "Unrecognized Java type: ~A" type))))
     100
     101(defun java::emit-unbox-and-return (return-type)
     102  (cond
     103    ((eq return-type :void)
     104     (emit 'pop)
     105     (emit 'return))
     106    ((eq return-type :int)
     107     (emit-invokevirtual +lisp-object+ "intValue" nil :int)
     108     (emit 'ireturn))
     109    ((eq return-type :boolean)
     110     (emit-invokevirtual +lisp-object+ "getBooleanValue" nil :boolean)
     111     (emit 'ireturn))
     112    ((jvm-class-name-p return-type)
     113     (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
     114     (emit-checkcast return-type)
     115     (emit 'areturn))
     116    (t
     117     (error "Unsupported return type: ~A" return-type))))
     118
    85119(defun java::runtime-class-add-methods (class-file methods)
    86120  (let (method-implementation-fields)
    87121    (dolist (m methods)
    88       (destructuring-bind (name return-type argument-types function &key (modifiers '(:public)) annotations) m
    89         (let* ((argument-types (mapcar #'make-jvm-class-name argument-types))
     122      (destructuring-bind (name return-type argument-types function
     123                           &key (modifiers '(:public)) annotations override) m
     124        (let* ((argument-types (mapcar #'java::canonicalize-java-type argument-types))
    90125               (argc (length argument-types))
    91                (return-type (if (keywordp return-type)
    92                                 return-type
    93                                 (make-jvm-class-name return-type)))
     126               (return-type (java::canonicalize-java-type return-type))
    94127               (jmethod (make-jvm-method name return-type argument-types :flags modifiers))
    95128               (field-name (string (gensym name))))
     
    136169                (error "execute(LispObject[]) is currently not supported"))
    137170            (emit-call-execute (1+ (length argument-types)))
    138             (cond
    139               ((eq return-type :void)
    140                (emit 'pop)
    141                (emit 'return))
    142               ((eq return-type :int)
    143                (emit-invokevirtual +lisp-object+ "intValue" nil :int)
    144                (emit 'ireturn))
    145               ((eq return-type :boolean)
    146                (emit-invokevirtual +lisp-object+ "getBooleanValue" nil :boolean)
    147                (emit 'ireturn))
    148               ((jvm-class-name-p return-type)
    149                (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
    150                (emit-checkcast return-type)
    151                (emit 'areturn))
    152               (t
    153                (error "Unsupported return type: ~A" return-type)))))))
     171            (java::emit-unbox-and-return return-type))
     172          (cond
     173            ((eq override t)
     174             (let ((super-method
     175                    (make-jvm-method (format nil "super$~A" name)
     176                                     return-type argument-types :flags modifiers)))
     177               (class-add-method class-file super-method)
     178               (with-code-to-method (class-file super-method)
     179                 (dotimes (i (1+ (length argument-types)))
     180                   (allocate-register nil))
     181                 (aload 0)
     182                 (loop
     183                    :for arg-type :in argument-types
     184                    :for i :from 1
     185                    :do (progn
     186                          (cond
     187                            ((keywordp arg-type)
     188                             (error "Unsupported arg-type: ~A" arg-type))
     189                            ((eq arg-type :int) :todo)
     190                            (t (aload i)))))
     191                 (emit-invokespecial (class-file-superclass class-file) name
     192                                     argument-types return-type)
     193                 ;(emit 'pop)
     194                 (cond
     195                   ((eq return-type :void)
     196                    (emit 'return))
     197                   ((eq return-type :int)
     198                    (emit 'ireturn))
     199                   ((eq return-type :boolean)
     200                    (emit 'ireturn))
     201                   ((jvm-class-name-p return-type)
     202                    (emit 'areturn))
     203                   (t
     204                    (error "Unsupported return type: ~A" return-type))))))))))
    154205    method-implementation-fields))
    155206
Note: See TracChangeset for help on using the changeset viewer.