Changeset 14882


Ignore:
Timestamp:
10/01/16 13:09:07 (7 years ago)
Author:
Mark Evenson
Message:

Revert r15858 to restore working CFFI-TESTS invocation

<​http://abcl.org/trac/timeline/14882> vc:reverts <​http://abcl.org/trac/changeset/14858>.

Location:
trunk/abcl
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/LispObject.java

    r14858 r14882  
    129129  public Object javaInstance(Class<?> c)
    130130  {
    131       String cn = c.getName();
    132       if (cn.equals("java.lang.Boolean") || cn.equals("boolean"))
    133           return Boolean.TRUE;
    134131      if (c.isAssignableFrom(getClass()))
    135132    return this;

  • trunk/abcl/src/org/armedbear/lisp/Nil.java

    r14858 r14882  
    4545        pkg.addSymbol(this);
    4646        initializeConstant(this);
    47     }
    48 
    49     @Override
    50     public Object javaInstance()
    51     {
    52         return null;
    53     }
    54 
    55     @Override
    56     public Object javaInstance(Class c)
    57     {
    58         String cn = c.getName();
    59         if (cn.equals("java.lang.Boolean") || cn.equals("boolean"))
    60             return Boolean.FALSE;
    61         return javaInstance();
    6247    }
    6348

  • trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

    r14858 r14882  
    462462    (t (emit 'astore index))))
    463463
    464 (defknown iload (fixnum) t)
    465 (defun iload (index)
    466   (case index
    467     (0 (emit 'iload_0))
    468     (1 (emit 'iload_1))
    469     (2 (emit 'iload_2))
    470     (3 (emit 'iload_3))
    471     (t (emit 'iload index))))
    472 
    473 (defknown istore (fixnum) t)
    474 (defun istore (index)
    475   (case index
    476     (0 (emit 'istore_0))
    477     (1 (emit 'istore_1))
    478     (2 (emit 'istore_2))
    479     (3 (emit 'istore_3))
    480     (t (emit 'istore index))))
    481 
    482464(declaim (ftype (function (t) t) branch-p)
    483465         (inline branch-p))
    … …  
    590572                 14 ; dconst_0
    591573                 15 ; dconst_1
    592                  26 ; iload_0
    593                  27 ; iload_1
    594                  28 ; iload_2
    595                  29 ; iload_3
    596574                 42 ; aload_0
    597575                 43 ; aload_1
    … …  
    603581                 49 ; daload
    604582                 50 ; aaload
    605                  54 ; istore
    606                  59 ; istore_0
    607                  60 ; istore_1
    608                  61 ; istore_2
    609                  62 ; istore_3
    610583                 75 ; astore_0
    611584                 76 ; astore_1

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

    r14858 r14882  
    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 
    1310(defun java:jnew-runtime-class
    1411    (class-name &rest args &key (superclass "java.lang.Object")
    15      interfaces constructors methods fields (access-flags '(:public)) annotations
    16      (class-loader (java::make-memory-class-loader)))
     12     interfaces constructors methods fields (access-flags '(:public)) annotations)
    1713  "Creates and loads a Java class with methods calling Lisp closures
    1814   as given in METHODS.  CLASS-NAME and SUPER-NAME are strings,
    … …  
    3632     (METHOD-NAME RETURN-TYPE ARGUMENT-TYPES FUNCTION &key MODIFIERS ANNOTATIONS)
    3733
    38    where
    39       METHOD-NAME is a string
     34   where 
     35      METHOD-NAME is a string 
    4036      RETURN-TYPE denotes the type of the object returned by the method
    4137      ARGUMENT-TYPES is a list of parameters to the method
    42 
    43         The types are either strings naming fully qualified java classes or Lisp keywords referring to
     38     
     39        The types are either strings naming fully qualified java classes or Lisp keywords referring to 
    4440        primitive types (:void, :int, etc.).
    4541
    … …  
    5046   Field definitions are lists of the form (field-name type &key modifiers annotations)."
    5147  (declare (ignorable superclass interfaces constructors methods fields access-flags annotations))
    52   (let ((stream (sys::%make-byte-array-output-stream)))
     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)))
    5351    (multiple-value-bind (class-file method-implementation-fields)
    54         (apply #'java::%jnew-runtime-class class-name stream :allow-other-keys T args)
    55       (sys::put-memory-function class-loader
     52        (apply #'java::%jnew-runtime-class class-name stream args)
     53      (sys::put-memory-function memory-class-loader
    5654                                class-name (sys::%get-output-stream-bytes stream))
    57       (let ((jclass (java:jcall "loadClass" class-loader class-name)))
     55      (let ((jclass (java:jcall "loadClass" memory-class-loader class-name)))
    5856        (dolist (method method-implementation-fields)
    5957          (setf (java:jfield jclass (car method)) (cdr method)))
    6058        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)))))
    8259
    8360(defun java::%jnew-runtime-class
    … …  
    10279          (emit-invokespecial-init (class-file-superclass class-file) nil)
    10380          (emit 'return)))
    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))))))
     81      (error "constructors not supported"))
    14582    (finalize-class-file class-file)
    14683    (write-class-file class-file stream)
    … …  
    186123     (emit 'ireturn))
    187124    ((jvm-class-name-p return-type)
    188      (emit 'ldc_w (pool-class return-type))
    189      (emit-invokevirtual +lisp-object+ "javaInstance" (list +java-class+) +java-object+)
     125     (emit-invokevirtual +lisp-object+ "javaInstance" nil +java-object+)
    190126     (emit-checkcast return-type)
    191127     (emit 'areturn))
    … …  
    195131(defun java::runtime-class-add-methods (class-file methods)
    196132  (let (method-implementation-fields)
    197     (dolist (method methods)
     133    (dolist (m methods)
    198134      (destructuring-bind (name return-type argument-types function
    199                            &key (modifiers '(:public)) annotations override)
    200           method
     135                           &key (modifiers '(:public)) annotations override) m
    201136        (let* ((argument-types (mapcar #'java::canonicalize-java-type argument-types))
    202137               (argc (length argument-types))
    203138               (return-type (java::canonicalize-java-type return-type))
    204139               (jmethod (make-jvm-method name return-type argument-types :flags modifiers))
    205                (field-name (string (gensym name)))
    206                (staticp (member :static modifiers))
    207                (offset (if staticp 0 1))
    208                (all-argc (+ argc offset)))
     140               (field-name (string (gensym name))))
    209141          (class-add-method class-file jmethod)
    210142          (let ((field (make-field field-name +lisp-object+ :flags '(:public :static))))
    … …  
    216148          (with-code-to-method (class-file jmethod)
    217149            ;;Allocate registers (2 * argc to load and store arguments + 2 to box "this")
    218             (dotimes (i (* 2 all-argc))
     150            (dotimes (i (* 2 (1+ argc)))
    219151              (allocate-register nil))
    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)
     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)))))
    228172            ;;Load the Lisp function from its static field
    229173            (emit-getstatic (class-file-class class-file) field-name +lisp-object+)
    230             (if (<= all-argc call-registers-limit)
     174            (if (<= (1+ argc) call-registers-limit)
    231175                (progn
    232176                  ;;Load the boxed this
    233                   (unless staticp
    234                     (aload all-argc))
     177                  (aload (1+ argc))
    235178                  ;;Load each boxed argument
    236179                  (dotimes (i argc)
    237                     (aload (+ i 1 all-argc))))
     180                    (aload (+ argc 2 i))))
    238181                (error "execute(LispObject[]) is currently not supported"))
    239             (emit-call-execute all-argc)
     182            (emit-call-execute (1+ (length argument-types)))
    240183            (java::emit-unbox-and-return return-type))
    241184          (cond

  • trunk/abcl/test/lisp/abcl/runtime-class.lisp

    r14858 r14882  
    11(in-package :abcl.test.lisp)
     2
    23
    34;; method with no arguments
    45(deftest runtime-class.1
    5     (java:jclass-name
    6      (java:jnew-runtime-class
    7       "Actor"
    8       :fields '(("name" "java.lang.String" :getter NIL))
    9       :methods '(("getName" "java.lang.String" NIL
    10                   (lambda (this)
    11                     (java:jfield "name" this))))))
    12   "Actor")
     6    (java:jnew-runtime-class
     7     "Actor"
     8     :fields `(("name" "java.lang.String"))
     9     :methods `(("getName" "java.lang.String" nil
     10                           (lambda (this)
     11                             (java:jfield this "name")))))
     12  t)
    1313
    1414;; method with primitive type
    1515(deftest runtime-class.2
    16     (java:jclass-name
    17      (java:jnew-runtime-class
    18       "Actor"
    19       :fields '(("name" "java.lang.String" :getter NIL))
    20       :methods '(("getName" "java.lang.String" (:int)
    21                   (lambda (this x)
    22                     (declare (ignore x))
    23                     (java:jfield "name" this))))))
    24   "Actor")
     16    (java:jnew-runtime-class
     17     "Actor"
     18     :fields `(("name" "java.lang.String"))
     19     :methods `(("getName" "java.lang.String" (:int)
     20                           (lambda (this)
     21                             (java:jfield this "name")))))
     22  t)
    2523
    26 ;; inheritance of type
     24;; inheritance of type
     25
    2726(deftest runtime-class.3
    28     (let ((class-loader (java::make-memory-class-loader)))
    29       (java:jnew-runtime-class
     27    (progn
     28      (java:jnew-runtime-class 
    3029       "foo.Actor"
    31        :fields '(("name" "java.lang.String"))
    32        :class-loader class-loader)
    33       (java:jclass-name
    34        (java:jnew-runtime-class
    35         "foo.StageActor"
    36         :superclass "foo.Actor"
    37         :fields '(("givenName" "java.lang.String"))
    38         :class-loader class-loader)))
    39   "foo.StageActor")
     30       :fields `(("name" "java.lang.String")))
     31      (java:jnew-runtime-class
     32       "foo.StageActor"
     33       :superclass "foo.Actor"
     34       :fields (list '("givenName" "java.lang.String"))))
     35  t)
     36
     37
     38#|
     39// Simple constructor test
     40public class Actor {
     41  String name;
     42 
     43  public Actor(String name) {
     44    this.name = name;
     45  }
     46
     47  public String getName() {
     48    return name;
     49  }
     50 
     51}
     52|#
    4053
    4154;; constructor
    4255(deftest runtime-class.4
    43     (java:jcall "getName"
    44                 (java:jnew
    45                  (java:jnew-runtime-class
    46                   "Actor"
    47                   :constructors '((("java.lang.String")
    48                                    (lambda (this name)
    49                                      (setf (java:jfield "name" this) name))))
    50                   :methods '(("getName" "java.lang.String" NIL
    51                               (lambda (this)
    52                                 (java:jfield "name" this))))
    53                   :fields '(("name" "java.lang.String" :getter NIL)))
    54                  "Someone"))
    55   "Someone")
     56    (java:jnew-runtime-class
     57     "Actor"
     58     :constructors `(("java.lang.String")
     59                     (lambda (name)
     60                       (setf (jfield this "name")
     61                             name)))
     62     :methods `(("getName" "java.lang.String" ("java.lang.String")  ;; no-arg methods not working
     63                           (lambda (this dummy)
     64                             (declare (ignore dummy))
     65                             (java:jfield this "name"))))
     66     :fields `(("name" "java.lang.String")))
     67  t)
     68
     69
     70   
Note: See TracChangeset for help on using the changeset viewer.