Ignore:
Timestamp:
Dec 2, 2008, 3:10:56 PM (11 years ago)
Author:
gb
Message:

Do the foreign-object-domain initialization more sanely.
JNI wrapper functions treat NULL args as +null-ptr+, return null pointers
as NIL.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/examples/jfli/jni.lisp

    r11447 r11454  
    6363    ())
    6464
    65 (ccl::defloadvar *java-object-domain*
    66     (ccl::register-foreign-object-domain :java
    67                                          :recognize #'ccl::false
    68                                          :class-of (lambda (x)
    69                                                      (declare (ignore x))
    70                                                      (find-class 'java-object))
    71                                          :classp #'ccl::false
    72                                          :instance-class-wrapper
    73                                          (lambda (x)
    74                                            (declare (ignore x))
    75                                            (ccl::class-own-wrapper
    76                                             (find-class 'java-object)))
    77                                          :class-own-wrapper
    78                                          #'ccl::false
    79                                          :slots-vector #'ccl::false
    80                                          :class-ordinal #'ccl::false
    81                                          :set-class-ordinal
    82                                          #'ccl::false))
     65(ccl::defloadvar *java-object-domain* nil)
     66
     67(or *java-object-domain*
     68    (setq *java-object-domain*
     69          (ccl::register-foreign-object-domain :java
     70                                               :recognize #'ccl::false
     71                                               :class-of (lambda (x)
     72                                                           (declare (ignore x))
     73                                                           (find-class 'java-object))
     74                                               :classp #'ccl::false
     75                                               :instance-class-wrapper
     76                                               (lambda (x)
     77                                                 (declare (ignore x))
     78                                                 (ccl::class-own-wrapper
     79                                                  (find-class 'java-object)))
     80                                               :class-own-wrapper
     81                                               #'ccl::false
     82                                               :slots-vector #'ccl::false
     83                                               :class-ordinal #'ccl::false
     84                                               :set-class-ordinal
     85                                               #'ccl::false)))
    8386
    8487(deftype java-ref () 'java-object)
     
    109112;;; Map between lisp and Java booleans
    110113(eval-when (:compile-toplevel)
    111   (declaim (inline jboolean-arg jboolean-result jobject-result)))
     114  (declaim (inline jboolean-arg jboolean-result jobject-result jobject-arg)))
    112115
    113116(defun jboolean-arg (val)
     
    116119    #$JNI_FALSE))
    117120
     121(defun jobject-arg (val)
     122  (or val ccl::+null-ptr+))
     123
     124
    118125(defun jboolean-result (val)
    119126  (not (eql val #$JNI_FALSE)))
     
    122129(defun jobject-result (val)
    123130  (unless (ccl::%null-ptr-p val)
    124     (ccl::%set-macptr-domain val *java-object-domain*))
    125   val)
     131    (ccl::%set-macptr-domain val *java-object-domain*)
     132    val))
    126133
    127134
     
    168175;;; JNIEnv functions.
    169176
     177(defun process-jnienv-call-args (specs)
     178  (ccl::collect ((args))
     179    (do* ((specs specs (cddr specs)))
     180         ((null specs) (args))
     181      (let* ((type (car specs))
     182             (valform (cadr specs)))
     183        (args type)
     184        (case type
     185          (:jboolean (args `(jboolean-arg ,valform)))
     186          ((:jobject :jclass :jstring :jthrowable :jarray #>jbooleanArray
     187                     #>jbyteArray #>jcharArray #>jshortArray #>jintArray
     188                     #>jlongArray #>jfloatArray #>jdoubleArray #>jobjectArray)
     189           (args `(jobject-arg ,valform)))
     190          (t (args valform)))))))
     191 
    170192(defmacro jnienv-call ((slot result-type) &rest specs)
    171193  ;; We might want to special-case some result-types for finalization.
     
    174196         (form
    175197          `(let* ((,env (current-env)))
    176             (ff-call (pref ,env ,accessor) :address ,env ,@specs ,result-type))))
     198            (ff-call (pref ,env ,accessor) :address ,env ,@(process-jnienv-call-args specs) ,result-type))))
    177199    (case result-type
    178200      (:jboolean `(jboolean-result ,form))
     
    211233               :jclass cls
    212234               #>jmethodID method-id
    213                :jboolean (jboolean-arg is-static)))
     235               :jboolean is-static))
    214236
    215237(defun get-superclass (sub)
     
    225247               :jclass cls
    226248               #>jfieldID field-id
    227                :jboolean (jboolean-arg is-static)))
     249               :jboolean is-static))
    228250
    229251(defun jni-throw (obj)
     
    490512               :jobject obj
    491513               #>jfieldID field-id
    492                :jboolean (jboolean-arg val)))
     514               :jboolean val))
    493515
    494516(defun set-byte-field (obj field-id val)
     
    669691               :jclass clazz
    670692               #>jfieldID field-id
    671                :jboolean (jboolean-arg value)))
     693               :jboolean value))
    672694
    673695(defun set-static-byte-field (clazz field-id value)
     
    11561178(defcallback |LispInvocationHandler_invoke|
    11571179    (:address env :jobject obj :jobject proxy :jobject method :jobject args :jobject)
    1158   (do-invoke env obj proxy method args))
     1180  (jobject-result obj)
     1181  (jobject-result proxy)
     1182  (jobject-result method)
     1183  (jobject-result args)
     1184  (jobject-arg
     1185   (do-invoke env obj proxy method args)))
    11591186
    11601187
     
    11751202;so take advantage of that when possible vs. the call back to exception-check
    11761203(defun try-null (result)
    1177   (if (ccl:%null-ptr-p result)
     1204  (if (or (null result) (ccl:%null-ptr-p result))
    11781205      (handle-exception)
    11791206    result))
     
    12571284(defun process-arg (val type)
    12581285  (if (string-equal "java.lang.String" type)
    1259                  `(convert-string-arg ,val)
    1260                  val))
     1286    `(convert-string-arg ,val)
     1287    `(or ,val ccl::+null-ptr+)))
    12611288
    12621289(defmacro set-arg (args i val type)
Note: See TracChangeset for help on using the changeset viewer.