Changeset 11454
- Timestamp:
- Dec 2, 2008, 3:10:56 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/examples/jfli/jni.lisp
r11447 r11454 63 63 ()) 64 64 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))) 83 86 84 87 (deftype java-ref () 'java-object) … … 109 112 ;;; Map between lisp and Java booleans 110 113 (eval-when (:compile-toplevel) 111 (declaim (inline jboolean-arg jboolean-result jobject-result )))114 (declaim (inline jboolean-arg jboolean-result jobject-result jobject-arg))) 112 115 113 116 (defun jboolean-arg (val) … … 116 119 #$JNI_FALSE)) 117 120 121 (defun jobject-arg (val) 122 (or val ccl::+null-ptr+)) 123 124 118 125 (defun jboolean-result (val) 119 126 (not (eql val #$JNI_FALSE))) … … 122 129 (defun jobject-result (val) 123 130 (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)) 126 133 127 134 … … 168 175 ;;; JNIEnv functions. 169 176 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 170 192 (defmacro jnienv-call ((slot result-type) &rest specs) 171 193 ;; We might want to special-case some result-types for finalization. … … 174 196 (form 175 197 `(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)))) 177 199 (case result-type 178 200 (:jboolean `(jboolean-result ,form)) … … 211 233 :jclass cls 212 234 #>jmethodID method-id 213 :jboolean (jboolean-arg is-static)))235 :jboolean is-static)) 214 236 215 237 (defun get-superclass (sub) … … 225 247 :jclass cls 226 248 #>jfieldID field-id 227 :jboolean (jboolean-arg is-static)))249 :jboolean is-static)) 228 250 229 251 (defun jni-throw (obj) … … 490 512 :jobject obj 491 513 #>jfieldID field-id 492 :jboolean (jboolean-arg val)))514 :jboolean val)) 493 515 494 516 (defun set-byte-field (obj field-id val) … … 669 691 :jclass clazz 670 692 #>jfieldID field-id 671 :jboolean (jboolean-arg value)))693 :jboolean value)) 672 694 673 695 (defun set-static-byte-field (clazz field-id value) … … 1156 1178 (defcallback |LispInvocationHandler_invoke| 1157 1179 (: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))) 1159 1186 1160 1187 … … 1175 1202 ;so take advantage of that when possible vs. the call back to exception-check 1176 1203 (defun try-null (result) 1177 (if ( ccl:%null-ptr-p result)1204 (if (or (null result) (ccl:%null-ptr-p result)) 1178 1205 (handle-exception) 1179 1206 result)) … … 1257 1284 (defun process-arg (val type) 1258 1285 (if (string-equal "java.lang.String" type) 1259 1260 val))1286 `(convert-string-arg ,val) 1287 `(or ,val ccl::+null-ptr+))) 1261 1288 1262 1289 (defmacro set-arg (args i val type)
Note: See TracChangeset
for help on using the changeset viewer.