Ignore:
Timestamp:
09/04/16 07:01:04 (5 years ago)
Author:
Mark Evenson
Message:

[PATCH 4/5] Runtime class improvements.
From faceaa2be78d92b6a6c43f5925fae926f9607bce Mon Sep 17 00:00:00 2001
Work in progress to get to a more functioning runtime class support.

  • Make static functions and :int parameters work.
  • Fix return conversion for null.
  • Ensure that the same classloader is used.

Because otherwise the name of the superclass couldn't be found as it's
not cached anywhere.

It would probably make sense to make the normal classloader a caching
one, so that custom classes can be found by other parts of the (Java)
system?

---

src/org/armedbear/lisp/LispObject.java | 3 +
src/org/armedbear/lisp/Nil.java | 15 +++
src/org/armedbear/lisp/jvm-instructions.lisp | 27 ++++++
src/org/armedbear/lisp/runtime-class.lisp | 139 +++++++++++++++++++--------
test/lisp/abcl/runtime-class.lisp | 101 +++++++++----------
5 files changed, 186 insertions(+), 99 deletions(-)

File:
1 edited

Legend:

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

    r14721 r14858  
    88(defconstant +abcl-java-object+ (make-jvm-class-name "org.armedbear.lisp.JavaObject"))
    99
     10(defun java::make-memory-class-loader (&optional (parent (java:get-current-classloader)))
     11  (java:jnew "org.armedbear.lisp.MemoryClassLoader" parent))
     12
    1013(defun java:jnew-runtime-class
    1114    (class-name &rest args &key (superclass "java.lang.Object")
    12      interfaces constructors methods fields (access-flags '(:public)) annotations)
     15     interfaces constructors methods fields (access-flags '(:public)) annotations
     16     (class-loader (java::make-memory-class-loader)))
    1317  "Creates and loads a Java class with methods calling Lisp closures
    1418   as given in METHODS.  CLASS-NAME and SUPER-NAME are strings,
     
    3236     (METHOD-NAME RETURN-TYPE ARGUMENT-TYPES FUNCTION &key MODIFIERS ANNOTATIONS)
    3337
    34    where 
    35       METHOD-NAME is a string 
     38   where
     39      METHOD-NAME is a string
    3640      RETURN-TYPE denotes the type of the object returned by the method
    3741      ARGUMENT-TYPES is a list of parameters to the method
    38      
    39         The types are either strings naming fully qualified java classes or Lisp keywords referring to 
     42
     43        The types are either strings naming fully qualified java classes or Lisp keywords referring to
    4044        primitive types (:void, :int, etc.).
    4145
     
    4650   Field definitions are lists of the form (field-name type &key modifiers annotations)."
    4751  (declare (ignorable superclass interfaces constructors methods fields access-flags annotations))
    48   (let* ((stream (sys::%make-byte-array-output-stream))
    49         (current-class-loader (java:get-current-classloader))
    50         (memory-class-loader (java:jnew "org.armedbear.lisp.MemoryClassLoader" current-class-loader)))
     52  (let ((stream (sys::%make-byte-array-output-stream)))
    5153    (multiple-value-bind (class-file method-implementation-fields)
    52         (apply #'java::%jnew-runtime-class class-name stream args)
    53       (sys::put-memory-function memory-class-loader
     54        (apply #'java::%jnew-runtime-class class-name stream :allow-other-keys T args)
     55      (sys::put-memory-function class-loader
    5456                                class-name (sys::%get-output-stream-bytes stream))
    55       (let ((jclass (java:jcall "loadClass" memory-class-loader class-name)))
     57      (let ((jclass (java:jcall "loadClass" class-loader class-name)))
    5658        (dolist (method method-implementation-fields)
    5759          (setf (java:jfield jclass (car method)) (cdr method)))
    5860        jclass))))
     61
     62(defconstant +abcl-lisp-integer-object+ (make-jvm-class-name "org.armedbear.lisp.LispInteger"))
     63
     64(defun box-arguments (argument-types offset all-argc)
     65  ;;Box each argument
     66  (loop
     67    :for arg-type :in argument-types
     68    :for i :from offset
     69    :do (progn
     70          (cond
     71            ((eq arg-type :int)
     72             (iload i)
     73             (emit-invokestatic +abcl-lisp-integer-object+ "getInstance"
     74                                (list :int) +abcl-lisp-integer-object+))
     75            ((keywordp arg-type)
     76             (error "Unsupported arg-type: ~A" arg-type))
     77            (t (aload i)
     78               (emit 'iconst_1) ;;true
     79               (emit-invokestatic +abcl-java-object+ "getInstance"
     80                                  (list +java-object+ :boolean) +lisp-object+)))
     81          (astore (+ i all-argc)))))
    5982
    6083(defun java::%jnew-runtime-class
     
    79102          (emit-invokespecial-init (class-file-superclass class-file) nil)
    80103          (emit 'return)))
    81       (error "constructors not supported"))
     104      (dolist (constructor constructors)
     105        (destructuring-bind (argument-types function
     106                             &key (modifiers '(:public)))
     107            constructor
     108          (let* ((argument-types (mapcar #'java::canonicalize-java-type argument-types))
     109                 (argc (length argument-types))
     110                 (ctor (make-jvm-method :constructor :void argument-types :flags modifiers))
     111                 (field-name (string (gensym "CONSTRUCTOR")))
     112                 (all-argc (1+ argc)))
     113            (class-add-method class-file ctor)
     114            (let ((field (make-field field-name +lisp-object+ :flags '(:public :static))))
     115              (class-add-field class-file field))
     116            (push (cons field-name function) method-implementation-fields)
     117            (with-code-to-method (class-file ctor)
     118              (dotimes (i (* 2 all-argc))
     119                (allocate-register nil))
     120
     121              (aload 0)
     122              (emit-invokespecial-init (class-file-superclass class-file) nil)
     123
     124              (aload 0)
     125              (emit 'iconst_1) ;;true
     126              (emit-invokestatic +abcl-java-object+ "getInstance"
     127                                 (list +java-object+ :boolean) +lisp-object+)
     128              (astore all-argc)
     129
     130              (box-arguments argument-types 1 all-argc)
     131
     132              ;;Load the Lisp function from its static field
     133              (emit-getstatic (class-file-class class-file) field-name +lisp-object+)
     134              (if (<= all-argc call-registers-limit)
     135                  (progn
     136                    ;;Load the boxed this
     137                    (aload all-argc)
     138                    ;;Load each boxed argument
     139                    (dotimes (i argc)
     140                      (aload (+ i 1 all-argc))))
     141                  (error "execute(LispObject[]) is currently not supported"))
     142              (emit-call-execute all-argc)
     143
     144              (emit 'return))))))
    82145    (finalize-class-file class-file)
    83146    (write-class-file class-file stream)
     
    123186     (emit 'ireturn))
    124187    ((jvm-class-name-p return-type)
    125      (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
     188     (emit 'ldc_w (pool-class return-type))
     189     (emit-invokevirtual +lisp-object+ "javaInstance" (list +java-class+) +java-object+)
    126190     (emit-checkcast return-type)
    127191     (emit 'areturn))
     
    131195(defun java::runtime-class-add-methods (class-file methods)
    132196  (let (method-implementation-fields)
    133     (dolist (m methods)
     197    (dolist (method methods)
    134198      (destructuring-bind (name return-type argument-types function
    135                            &key (modifiers '(:public)) annotations override) m
     199                           &key (modifiers '(:public)) annotations override)
     200          method
    136201        (let* ((argument-types (mapcar #'java::canonicalize-java-type argument-types))
    137202               (argc (length argument-types))
    138203               (return-type (java::canonicalize-java-type return-type))
    139204               (jmethod (make-jvm-method name return-type argument-types :flags modifiers))
    140                (field-name (string (gensym name))))
     205               (field-name (string (gensym name)))
     206               (staticp (member :static modifiers))
     207               (offset (if staticp 0 1))
     208               (all-argc (+ argc offset)))
    141209          (class-add-method class-file jmethod)
    142210          (let ((field (make-field field-name +lisp-object+ :flags '(:public :static))))
     
    148216          (with-code-to-method (class-file jmethod)
    149217            ;;Allocate registers (2 * argc to load and store arguments + 2 to box "this")
    150             (dotimes (i (* 2 (1+ argc)))
     218            (dotimes (i (* 2 all-argc))
    151219              (allocate-register nil))
    152             ;;Box "this" (to be passed as the first argument to the Lisp function)
    153             (aload 0)
    154             (emit 'iconst_1) ;;true
    155             (emit-invokestatic +abcl-java-object+ "getInstance"
    156                                (list +java-object+ :boolean) +lisp-object+)
    157             (astore (1+ argc))
    158             ;;Box each argument
    159             (loop
    160                :for arg-type :in argument-types
    161                :for i :from 1
    162                :do (progn
    163                      (cond
    164                        ((keywordp arg-type)
    165                         (error "Unsupported arg-type: ~A" arg-type))
    166                        ((eq arg-type :int) :todo)
    167                        (t (aload i)
    168                           (emit 'iconst_1) ;;true
    169                           (emit-invokestatic +abcl-java-object+ "getInstance"
    170                                              (list +java-object+ :boolean) +lisp-object+)))
    171                      (astore (+ i (1+ argc)))))
     220            (unless staticp
     221              ;;Box "this" (to be passed as the first argument to the Lisp function)
     222              (aload 0)
     223              (emit 'iconst_1) ;;true
     224              (emit-invokestatic +abcl-java-object+ "getInstance"
     225                                 (list +java-object+ :boolean) +lisp-object+)
     226              (astore all-argc))
     227            (box-arguments argument-types offset all-argc)
    172228            ;;Load the Lisp function from its static field
    173229            (emit-getstatic (class-file-class class-file) field-name +lisp-object+)
    174             (if (<= (1+ argc) call-registers-limit)
     230            (if (<= all-argc call-registers-limit)
    175231                (progn
    176232                  ;;Load the boxed this
    177                   (aload (1+ argc))
     233                  (unless staticp
     234                    (aload all-argc))
    178235                  ;;Load each boxed argument
    179236                  (dotimes (i argc)
    180                     (aload (+ argc 2 i))))
     237                    (aload (+ i 1 all-argc))))
    181238                (error "execute(LispObject[]) is currently not supported"))
    182             (emit-call-execute (1+ (length argument-types)))
     239            (emit-call-execute all-argc)
    183240            (java::emit-unbox-and-return return-type))
    184241          (cond
Note: See TracChangeset for help on using the changeset viewer.