--- /dev/null
+/* Emacs Lisp binding to Java Native Interface.
+ Copyright (C) 2000 Daiki Ueno.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+#include <emodules.h>
+#include <elhash.h>
+#include "java.h"
+
+#ifdef MULE
+#define JAVA_OS_CODING Fget_coding_system(Vjava_coding_system)
+#else
+#define JAVA_OS_CODING Qnative
+#endif
+
+Lisp_Object Vjava_coding_system;
+Lisp_Object Vjava_class_path;
+Lisp_Object Vjava_library_path;
+static Lisp_Object Qjava;
+
+Lisp_Object Qjavaclassp;
+Lisp_Object Qjavaobjectp;
+
+static JavaVM *java_jvm = NULL;
+static JNIEnv *java_env = NULL;
+
+#define JAVAVM_LIVE_P() (java_jvm && java_env)
+#define CHECK_LIVE_JAVAVM() do { \
+ if (!JAVAVM_LIVE_P ()) \
+ error ("Attempting to access uninitialized Java VM.\n"); \
+} while (0)
+
+static Extbyte *java_build_property_string (Lisp_Object, Lisp_Object);
+static void java_dots_to_slashes (Extbyte *);
+static int java_unify_parameter (JNIEnv *, const Extbyte *, Lisp_Object,
+ jvalue *);
+static Lisp_Object java_build_return_value (JNIEnv *, const Extbyte *, jvalue);
+
+typedef jlong (JNICALL *jni_method_caller)
+ (JNIEnv *, jobject, jmethodID, jvalue *);
+
+typedef jlong (JNICALL *jni_static_method_caller)
+ (JNIEnv *, jclass, jmethodID, jvalue *);
+
+typedef jlong (JNICALL *jni_nonvirtual_method_caller)
+ (JNIEnv *, jobject, jclass, jmethodID, jvalue *);
+
+typedef jarray (JNICALL *jni_array_allocater) (JNIEnv *, jsize);
+
+typedef void (*jni_array_setter) (JNIEnv *, jarray, jsize, jvalue);
+typedef jlong (*jni_array_referrer) (JNIEnv *, jarray, jsize);
+
+struct jni_primitive_wrapper {
+ jni_method_caller call_method;
+ jni_static_method_caller call_static_method;
+ jni_nonvirtual_method_caller call_nonvirtual_method;
+ jni_array_allocater new_array;
+ jni_array_setter set_array_element;
+ jni_array_referrer get_array_element;
+};
+
+typedef jboolean (*java_modifier_filter)(JNIEnv *, jint);
+
+struct java_class_list_closure
+{
+ Lisp_Object *java_class_list;
+};
+
+static struct jni_primitive_wrapper jni_primitive_call_table[8];
+static const Extbyte *jni_primitive_signature_table = "ZBCSIJFD";
+
+inline static jvalue jni_primitive_call_method
+ (JNIEnv *, const Extbyte *, jobject, jmethodID, jvalue *);
+inline static jvalue jni_primitive_call_static_method
+ (JNIEnv *, const Extbyte *, jclass, jmethodID, jvalue *);
+inline static jarray jni_primitive_new_array
+ (JNIEnv *, const Extbyte *, jsize);
+inline static void jni_primitive_set_array_element
+ (JNIEnv *, const Extbyte *, jarray, jsize, jvalue);
+inline static jvalue jni_primitive_get_array_element
+ (JNIEnv *, const Extbyte *, jarray, jsize);
+
+static void jni_initialize_primitive_call_table (JNIEnv *);
+static int jni_lookup_primitive_call_table (const char *);
+static jobjectArray jni_class_get_methods (JNIEnv *, jclass);
+static jobjectArray jni_class_get_constructors (JNIEnv *, jclass);
+static jstring jni_class_get_name (JNIEnv *, jclass class);
+static jboolean jni_class_is_primitive (JNIEnv *, jclass);
+static jobjectArray jni_method_get_parameter_types (JNIEnv *, jobject);
+static jstring jni_method_get_name (JNIEnv *, jobject);
+static jint jni_method_get_modifiers (JNIEnv *, jobject);
+static jclass jni_method_get_return_type (JNIEnv *, jobject);
+static jboolean jni_modifier_is_static (JNIEnv *, jint);
+static jboolean jni_modifier_is_non_static (JNIEnv *, jint);
+static void jni_check_exception (JNIEnv *);
+static jvalue jni_call_static_method (JNIEnv *, const Extbyte *,
+ jclass, jmethodID, jvalue *);
+static jvalue jni_call_virtual_method (JNIEnv *, const Extbyte *,
+ jobject, jmethodID, jvalue *);
+
+static Lisp_Object Vjava_class_hash_table;
+
+static void
+initialize_javavm (void)
+{
+ JavaVMInitArgs vm_args;
+ JavaVMOption options[2];
+ jint noptions = 0, status;
+
+ options[0].optionString = "abort";
+ options[0].extraInfo = abort;
+
+ if (!NILP (Vjava_class_path))
+ {
+ CHECK_STRING (Vjava_class_path);
+
+ options[noptions++].optionString =
+ java_build_property_string (build_string ("java.class.path"),
+ Vjava_class_path);
+ }
+
+ vm_args.version = JNI_VERSION_1_2;
+ vm_args.options = options;
+ vm_args.nOptions = noptions;
+ vm_args.ignoreUnrecognized = JNI_TRUE;
+
+ status = JNI_CreateJavaVM (&java_jvm, (void **)&java_env, &vm_args);
+ if (status < 0)
+ error ("Can't create Java VM. Error: %ld\n", status);
+
+ jni_initialize_primitive_call_table (java_env);
+}
+
+static void
+finalize_javavm (void)
+{
+ (*java_jvm)->DestroyJavaVM (java_jvm);
+ java_jvm = NULL;
+ java_env = NULL;
+}
+
+static Lisp_Object
+make_javaclass (Lisp_JavaClass *javaclass)
+{
+ Lisp_Object lisp_javaclass;
+ XSETJAVACLASS (lisp_javaclass, javaclass);
+ return lisp_javaclass;
+}
+
+static Lisp_Object
+mark_javaclass (Lisp_Object obj)
+{
+ Lisp_JavaClass *javaclass = XJAVACLASS (obj);
+ return javaclass->name;
+}
+
+static void
+print_javaclass (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_JavaClass *javaclass;
+ char buf[256];
+
+ javaclass = XJAVACLASS (obj);
+
+ if (NILP (javaclass->name))
+ strcpy (buf, "#<javaclass>");
+ else
+ sprintf (buf, "#<javaclass \"%s\">", XSTRING_DATA (javaclass->name));
+ write_c_string (buf, printcharfun);
+}
+
+static Lisp_JavaClass *
+allocate_javaclass (void)
+{
+ Lisp_JavaClass *javaclass = alloc_lcrecord_type (Lisp_JavaClass,
+ &lrecord_javaclass);
+
+ javaclass->class = (jclass)NULL;
+ javaclass->name = Qnil;
+ return javaclass;
+}
+
+DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaclass", javaclass,
+ mark_javaclass, print_javaclass, NULL,
+ NULL, NULL,
+ 0,
+ Lisp_JavaClass);
+
+static Lisp_Object
+make_javaobject (Lisp_JavaObject *javaobject)
+{
+ Lisp_Object lisp_javaobject;
+ XSETJAVAOBJECT (lisp_javaobject, javaobject);
+ return lisp_javaobject;
+}
+
+static Lisp_Object
+mark_javaobject (Lisp_Object obj)
+{
+ Lisp_JavaObject *javaobject = XJAVAOBJECT (obj);
+ return javaobject->signature;
+}
+
+static void
+print_javaobject (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ Lisp_JavaObject *javaobject;
+ char buf[256];
+
+ javaobject = XJAVAOBJECT (obj);
+
+ if (NILP (javaobject->signature))
+ strcpy (buf, "#<javaobject>");
+ else
+ sprintf (buf, "#<javaobject \"%s\">",
+ XSTRING_DATA (javaobject->signature));
+ write_c_string (buf, printcharfun);
+}
+
+static Lisp_JavaObject *
+allocate_javaobject (void)
+{
+ Lisp_JavaObject *javaobject;
+
+ javaobject = alloc_lcrecord_type (Lisp_JavaObject, &lrecord_javaobject);
+ javaobject->object = (jobject)NULL;
+ javaobject->signature = Qnil;
+ return javaobject;
+}
+
+DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaobject", javaobject,
+ mark_javaobject, print_javaobject,
+ NULL, NULL, NULL,
+ 0,
+ Lisp_JavaObject);
+
+DEFUN ("java-initialize", Fjava_initialize, 0, 0, 0, /*
+Initialize the Java Virtual Machine.
+*/
+ ())
+{
+ if (JAVAVM_LIVE_P ())
+ return Qnil;
+
+ initialize_javavm ();
+ if (JAVAVM_LIVE_P ())
+ return Qt;
+
+ return Qnil; /* not reached */
+}
+
+DEFUN ("java-finalize", Fjava_finalize, 0, 0, 0, /*
+Finalize the Java Virtual Machine.
+*/
+ ())
+{
+ CHECK_LIVE_JAVAVM ();
+ finalize_javavm ();
+
+ return Qnil;
+}
+
+DEFUN ("java-find-class", Fjava_find_class, 1, 1, 0, /*
+Find class by name.
+*/
+ (name))
+{
+ char *c_name;
+ jclass clazz;
+ Lisp_JavaClass *javaclass;
+ Lisp_Object class;
+
+ CHECK_LIVE_JAVAVM ();
+ CHECK_STRING (name);
+
+ class = Fgethash (name, Vjava_class_hash_table, Qnil);
+ if (JAVACLASSP (class))
+ return class;
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
+ java_dots_to_slashes (c_name);
+ clazz = (*java_env)->FindClass (java_env, c_name);
+ if (!clazz)
+ error ("Can't locate the %s class", XSTRING_DATA (name));
+
+ javaclass = allocate_javaclass ();
+ javaclass->class = clazz;
+ javaclass->name = name;
+
+ class = make_javaclass (javaclass);
+ Fputhash (javaclass->name, class, Vjava_class_hash_table);
+ return class;
+}
+
+static Extbyte *
+java_build_property_string (name, value)
+ Lisp_Object name, value;
+{
+ const Extbyte *c_name, *c_value;
+ Extbyte *c_property;
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
+ TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, c_value, Qnative);
+
+ c_property = xmalloc (strlen (c_name) + strlen (c_value) + 4);
+ sprintf (c_property, "-D%s=%s", c_name, c_value);
+
+ return c_property;
+}
+
+static void
+java_dots_to_slashes (c_class)
+ Extbyte *c_class;
+{
+ const Extbyte *end;
+
+ for (end = c_class + strlen (c_class); c_class < end; c_class++)
+ if (*c_class == '.')
+ *c_class = '/';
+}
+
+inline static Extbyte *
+java_primitive_type_signature (name)
+ const Extbyte *name;
+{
+ if (!strncmp (name, "boolean", 7))
+ return "Z";
+ else if (!strncmp (name, "byte", 4))
+ return "B";
+ else if (!strncmp (name, "char", 4))
+ return "C";
+ else if (!strncmp (name, "short", 5))
+ return "S";
+ else if (!strncmp (name, "int", 3))
+ return "I";
+ else if (!strncmp (name, "long", 4))
+ return "J";
+ else if (!strncmp (name, "float", 5))
+ return "F";
+ else if (!strncmp (name, "double", 6))
+ return "D";
+ else if (!strncmp (name, "void", 4))
+ return "V";
+}
+
+static const Extbyte *
+java_type_signature (env, class)
+ JNIEnv *env;
+ jclass class;
+{
+ jstring string = jni_class_get_name (env, class);
+ const Extbyte *utf_string, *signature;
+ Extbyte *buf;
+ jboolean is_copy;
+
+ utf_string = (*env)->GetStringUTFChars (env, string, &is_copy);
+
+ if (jni_class_is_primitive (env, class))
+ signature = java_primitive_type_signature (utf_string);
+ else if (utf_string[0] == '[')
+ {
+ signature = buf = xstrdup (utf_string);
+ java_dots_to_slashes (buf);
+ }
+ else
+ {
+ signature = buf = xmalloc (strlen (utf_string) + 3);
+ sprintf (buf, "L%s;", utf_string);
+ java_dots_to_slashes (buf);
+ }
+ if (is_copy == JNI_TRUE)
+ (*env)->ReleaseStringUTFChars (env, string, utf_string);
+
+ return signature;
+}
+
+static jarray
+java_unify_primitive_array (env, element_sig, obj)
+ JNIEnv *env;
+ const Extbyte *element_sig;
+ Lisp_Object obj;
+{
+ int i, index, len = XVECTOR_LENGTH (obj);
+ Lisp_Object *data = XVECTOR_DATA (obj);
+ jarray array;
+
+ array = jni_primitive_new_array (env, element_sig, len);
+
+ for (i = 0; i<len; i++)
+ {
+ jvalue param;
+ if (!java_unify_parameter (env, element_sig, data[i], ¶m))
+ return NULL;
+ jni_primitive_set_array_element (env, element_sig, array, i, param);
+ }
+ return array;
+}
+
+static jarray
+java_unify_object_array (env, element_sig, obj)
+ JNIEnv *env;
+ const Extbyte *element_sig;
+ Lisp_Object obj;
+{
+ int i, index, len = XVECTOR_LENGTH (obj);
+ Lisp_Object *data = XVECTOR_DATA (obj);
+ jarray array;
+ int element_sig_len = strlen (element_sig);
+ Extbyte *name = xstrdup (element_sig + 1);
+ Lisp_Object class;
+
+ name[element_sig_len - 2] = '\0'; /* remove the last ";" */
+ class = Fjava_find_class (build_string (name));
+ array = (*env)->NewObjectArray (env, len, XJAVACLASS (class)->class, NULL);
+ xfree (name);
+
+ name = alloca (element_sig_len + 1);
+ strncpy (name, element_sig, element_sig_len);
+ name[element_sig_len] = '\0';
+ for (i = 0; i<len; i++)
+ {
+ jvalue param;
+ if (!java_unify_parameter (env, name, data[i], ¶m))
+ return NULL;
+ (*env)->SetObjectArrayElement (env, array, i, param.l);
+ }
+ return array;
+}
+
+/* Convert a Lisp object into a Java object according to PARAM_SIG. */
+static int
+java_unify_parameter (env, param_sig, obj, param)
+ JNIEnv *env;
+ const Extbyte *param_sig;
+ Lisp_Object obj;
+ jvalue *param;
+{
+ switch (param_sig[0])
+ {
+ case 'Z':
+ param->z = NILP (obj) ? JNI_FALSE : JNI_TRUE;
+ break;
+ case 'B':
+ if (!INTP (obj))
+ return 0;
+ param->b = (jshort) XINT (obj);
+ break;
+ case 'C':
+ if (CHARP (obj))
+ {
+ obj = Fchar_ucs (obj);
+ if (!INTP(obj))
+ return 0;
+ param->c = (jchar) XINT (obj);
+ }
+ break;
+ case 'S':
+ if (!INTP (obj))
+ return 0;
+ param->s = (jshort) XINT (obj);
+ break;
+ case 'I':
+ if (!INTP (obj))
+ return 0;
+ param->i = (jint) XINT (obj);
+ break;
+ case 'J':
+ if (!INTP (obj))
+ return 0;
+ param->j = (jlong) XINT (obj);
+ break;
+ case 'F':
+ if (!INT_OR_FLOATP (obj))
+ return 0;
+ param->f = (jfloat) XFLOATINT (obj);
+ break;
+ case 'D':
+ if (!INT_OR_FLOATP (obj))
+ return 0;
+ param->d = (jdouble) XFLOATINT (obj);
+ break;
+ case 'L':
+ if (!JAVAOBJECTP (obj) && !STRINGP (obj)
+ || strncmp (param_sig, "Ljava/lang/String;", 18))
+ return 0;
+ if (JAVAOBJECTP (obj))
+ param->l = XJAVAOBJECT (obj)->object;
+ else if (STRINGP (obj))
+ {
+ const Extbyte *c_string;
+ TO_EXTERNAL_FORMAT (LISP_STRING, obj, C_STRING_ALLOCA,
+ c_string, Qnative);
+ param->l = (jobject) (*env)->NewStringUTF (env, c_string);
+ }
+ break;
+ case '[':
+ if (!VECTORP (obj) && !BIT_VECTORP (obj)
+ || !strncmp (param_sig, "[Z", 2))
+ return 0;
+ if (BIT_VECTORP (obj))
+ obj = vconcat2 (obj, Qnil);
+ if (param_sig[1] == 'L')
+ param->l = java_unify_object_array (env, param_sig+1, obj);
+ else
+ param->l = java_unify_primitive_array (env, param_sig+1, obj);
+ if (!param->l)
+ return 0;
+ break;
+ }
+ return 1;
+}
+
+static const Extbyte *
+java_unify_parameters (env, ptypes, nargs, args, params)
+ JNIEnv *env;
+ int nargs;
+ jobjectArray ptypes;
+ Lisp_Object *args;
+ jvalue *params;
+{
+ int i, bufsize = 128, nptypes = (*env)->GetArrayLength (env, ptypes);
+ char *p, *buf = xmalloc_and_zero (bufsize);
+
+ for (p = buf, i = 0; i < nptypes; i++)
+ {
+ jclass element = (*env)->GetObjectArrayElement (env, ptypes, i);
+ const Extbyte *param_sig = java_type_signature (env, element);
+ int len = strlen (param_sig);
+ (*env)->DeleteLocalRef (env, element);
+ if (!java_unify_parameter (env, param_sig, args[i], ¶ms[i]))
+ {
+ xfree (buf);
+ return NULL;
+ }
+
+ while ((buf - p) + len > bufsize)
+ {
+ bufsize *= 2;
+ buf = xrealloc (buf, bufsize);
+ }
+
+ strncpy (buf, param_sig, len);
+ }
+ return buf;
+}
+
+static Lisp_Object
+java_build_return_value_vector (env, return_sig, array)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jarray array;
+{
+ jint len = (*env)->GetArrayLength (env, array);
+ Lisp_Object v = make_vector (len, Qnil);
+ int i;
+ Extbyte *name = xstrdup (return_sig);
+ jvalue element;
+
+ if (name[0] == 'L' || name[0] == '[')
+ for (i = 0; i<len; i++)
+ {
+ element.l = (*env)->GetObjectArrayElement (env, array, i);
+ Faset (v, make_int (i), java_build_return_value (env, name, element));
+ }
+ else
+ for (i = 0; i<len; i++)
+ {
+ element = jni_primitive_get_array_element (env, name, array, i);
+ Faset (v, make_int (i), java_build_return_value (env, name, element));
+ }
+ xfree (name);
+ return v;
+}
+
+/* Convert a Java object into a Lisp object according to RETURN_SIG. */
+static Lisp_Object
+java_build_return_value (env, return_sig, value)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jvalue value;
+{
+ switch (return_sig[0])
+ {
+ case 'Z':
+ return value.z ? Qt : Qnil;
+ case 'B':
+ return make_int (value.b);
+ case 'C':
+ {
+ Lisp_Object ucs = make_int (value.c);
+ return Fucs_char (ucs);
+ }
+ case 'S':
+ return make_int (value.s);
+ case 'I':
+ return make_int (value.i);
+ case 'J':
+ return make_int (value.j);
+ case 'F':
+ return make_float (value.f);
+ case 'D':
+ return make_float (value.d);
+ case 'L':
+ if (!strncmp (return_sig, "Ljava/lang/String;", 18))
+ {
+ const Extbyte *utf_string;
+ jboolean is_copy;
+ Lisp_Object string;
+
+ if (!value.l)
+ return Qnil;
+ utf_string = (*env)->GetStringUTFChars (env, value.l, &is_copy);
+ string = build_ext_string (utf_string, JAVA_OS_CODING);
+ if (is_copy == JNI_TRUE)
+ (*env)->ReleaseStringUTFChars (env, value.l, utf_string);
+
+ return string;
+ }
+ else {
+ Lisp_JavaObject *javaobject;
+
+ javaobject = allocate_javaobject ();
+ javaobject->object = value.l;
+ javaobject->signature = build_string (return_sig);
+
+ return make_javaobject (javaobject);
+ }
+ break;
+ case '[':
+ return java_build_return_value_vector (env, return_sig+1, value.l);
+ }
+
+ error ("Can't cast the return value.");
+
+ return Qnil;
+}
+
+static jobject
+java_find_method (env, methods, c_method_to_invoke,
+ nargs, args, params, filter)
+ JNIEnv *env;
+ jobjectArray methods;
+ const Extbyte *c_method_to_invoke;
+ int nargs;
+ Lisp_Object *args;
+ jvalue *params;
+ java_modifier_filter filter;
+{
+ jobject method = NULL;
+ jint nmethods;
+ int i;
+
+ nmethods = (*env)->GetArrayLength (env, methods);
+ for (i = 0; i < nmethods; i++)
+ {
+ jobject element =
+ (*env)->GetObjectArrayElement (env, methods, i);
+ jint modifiers = jni_method_get_modifiers (env, element);
+ jobjectArray ptypes;
+ int nptypes;
+ jstring name = jni_method_get_name (env, element);
+ const Extbyte *utf_name, *param_sig;
+ jboolean is_copy;
+
+ utf_name = (*java_env)->GetStringUTFChars (env, name, &is_copy);
+
+ if (c_method_to_invoke && strcmp (utf_name, c_method_to_invoke))
+ goto retry;
+ if (filter && (*filter) (env, modifiers) != JNI_TRUE)
+ goto retry;
+
+ ptypes = jni_method_get_parameter_types (env, element);
+ nptypes = (*env)->GetArrayLength (env, ptypes);
+
+ if (nptypes != nargs)
+ goto retry;
+
+ param_sig = java_unify_parameters (env, ptypes, nargs, args, params);
+ if (!param_sig)
+ goto retry;
+
+ method = element;
+ break;
+
+ retry:
+ if (is_copy == JNI_TRUE)
+ (*env)->ReleaseStringUTFChars (env, name, utf_name);
+ (*env)->DeleteLocalRef (env, element);
+ }
+ return method;
+}
+
+static Lisp_Object
+java_call_static_method (obj, name, nargs, args)
+ Lisp_Object obj, name, *args;
+ int nargs;
+{
+ jclass class, return_type;
+ jobjectArray methods;
+ jobject method;
+ jvalue *params, value;
+ jmethodID method_id;
+ Extbyte *c_name;
+ const Extbyte *return_sig;
+ java_modifier_filter filter;
+
+ /* Prepare for the static method call. */
+ class = XJAVACLASS (obj)->class;
+ filter = jni_modifier_is_static;
+ params = alloca (sizeof (jvalue) * nargs);
+
+ /* Do unification in the ordinary way.
+ This part can be commonly used and should be split off. */
+ methods = jni_class_get_methods (java_env, class);
+ TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
+ method = java_find_method (java_env, methods, c_name, nargs, args, params,
+ filter);
+ if (!method)
+ error ("Bad method name: %s", XSTRING_DATA (name));
+
+ method_id = (*java_env)->FromReflectedMethod (java_env, method);
+ return_type = jni_method_get_return_type (java_env, method);
+ return_sig = java_type_signature (java_env, return_type);
+ (*java_env)->DeleteLocalRef (java_env, method);
+
+ value = jni_call_static_method (java_env, return_sig, class, method_id,
+ params);
+
+ /* Clean up returned value.
+ This part can be commonly used and should be split off. */
+ jni_check_exception (java_env);
+ if (!value.l) /* possibly null or void */
+ return Qnil;
+ return java_build_return_value (java_env, return_sig, value);
+}
+
+static Lisp_Object
+java_call_virtual_method (obj, name, nargs, args)
+ Lisp_Object obj, name, *args;
+ int nargs;
+{
+ jclass class, return_type;
+ jobjectArray methods;
+ jobject object, method;
+ jvalue *params, value;
+ jmethodID method_id;
+ Extbyte *c_name;
+ const Extbyte *return_sig;
+ java_modifier_filter filter;
+
+ /* Prepare for the virtual method call. */
+ object = XJAVAOBJECT (obj)->object;
+ class = (*java_env)->GetObjectClass (java_env, object);
+ filter = jni_modifier_is_non_static;
+ params = alloca (sizeof (jvalue) * nargs);
+
+ /* Do unification.
+ This part can be commonly used and should be split off. */
+ methods = jni_class_get_methods (java_env, class);
+ TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
+ method = java_find_method (java_env, methods, c_name, nargs, args, params,
+ filter);
+ if (!method)
+ error ("Bad method name: %s", XSTRING_DATA (name));
+
+ method_id = (*java_env)->FromReflectedMethod (java_env, method);
+ return_type = jni_method_get_return_type (java_env, method);
+ return_sig = java_type_signature (java_env, return_type);
+ (*java_env)->DeleteLocalRef (java_env, method);
+
+ value = jni_call_virtual_method (java_env, return_sig, object, method_id,
+ params);
+
+ /* Clean up returned value.
+ This part can be commonly used and should be split off. */
+ jni_check_exception (java_env);
+ if (!value.l) /* possibly null or void */
+ return Qnil;
+ return java_build_return_value (java_env, return_sig, value);
+}
+
+DEFUN ("java-call-static-method", Fjava_call_static_method, 2, MANY, 0, /*
+Call static method.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object class = args[0];
+ Lisp_Object method = args[1];
+ java_modifier_filter filter;
+
+ CHECK_JAVACLASS (class);
+ CHECK_STRING (method);
+ CHECK_LIVE_JAVAVM ();
+
+ return java_call_static_method (class, method, nargs - 2, args + 2);
+}
+
+DEFUN ("java-call-virtual-method", Fjava_call_virtual_method, 2, MANY, 0, /*
+Call static method.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object object = args[0];
+ Lisp_Object method = args[1];
+
+ CHECK_JAVAOBJECT (object);
+ CHECK_STRING (method);
+ CHECK_LIVE_JAVAVM ();
+
+ return java_call_virtual_method (object, method, nargs - 2, args + 2);
+}
+
+static Lisp_Object
+java_make_object (class, nargs, args)
+ Lisp_Object class, *args;
+ int nargs;
+{
+ jclass clazz;
+ jobjectArray constructors;
+ jobject constructor, object;
+ jvalue *params;
+ jmethodID method_id;
+ int i, nconstructors;
+ const Extbyte *param_sig;
+ Lisp_JavaObject *javaobject;
+
+ clazz = XJAVACLASS (class)->class;
+ constructors = jni_class_get_constructors (java_env, clazz);
+ nconstructors = (*java_env)->GetArrayLength (java_env, constructors);
+ params = alloca (sizeof (jvalue) * nargs);
+
+ constructor = java_find_method (java_env, constructors, NULL,
+ nargs, args, params, NULL);
+
+ if (!constructor)
+ error ("No such constructor: %s\n",
+ XSTRING_DATA (XJAVACLASS (class)->name));
+
+ method_id = (*java_env)->FromReflectedMethod (java_env, constructor);
+ object = (*java_env)->NewObjectA (java_env, clazz, method_id, params);
+
+ if (!object)
+ return Qnil;
+
+ javaobject = allocate_javaobject ();
+ javaobject->object = object;
+ javaobject->signature = XJAVACLASS (class)->name;
+
+ return make_javaobject (javaobject);
+}
+
+DEFUN ("java-make-object", Fjava_make_object, 1, MANY, 0, /*
+Call static method.
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object class = args[0];
+
+ CHECK_JAVACLASS (class);
+ CHECK_LIVE_JAVAVM ();
+
+ return java_make_object (class, nargs - 1, args + 1);
+}
+
+static int
+add_java_class_to_list_mapper (Lisp_Object key, Lisp_Object value,
+ void *java_class_list_closure)
+{
+ /* This function can GC */
+ struct java_class_list_closure *cscl =
+ (struct java_class_list_closure *) java_class_list_closure;
+ Lisp_Object *java_class_list = cscl->java_class_list;
+
+ *java_class_list = Fcons (value, *java_class_list);
+ return 0;
+}
+
+DEFUN ("java-class-list", Fjava_class_list, 0, 0, 0, /*
+Return a list of all loaded classes.
+*/
+ ())
+{
+ Lisp_Object java_class_list = Qnil;
+ struct gcpro gcpro1;
+ struct java_class_list_closure java_class_list_closure;
+
+ GCPRO1 (java_class_list);
+ java_class_list_closure.java_class_list = &java_class_list;
+ elisp_maphash (add_java_class_to_list_mapper, Vjava_class_hash_table,
+ &java_class_list_closure);
+ UNGCPRO;
+
+ return java_class_list;
+}
+
+DEFUN ("java-class-name", Fjava_class_name, 1, 1, 0, /*
+Return the name of the given class.
+*/
+ (class))
+{
+ CHECK_JAVACLASS (class);
+ return XJAVACLASS (class)->name;
+}
+
+static int
+jni_lookup_primitive_call_table (signature)
+ const char *signature;
+{
+ const char *p = strchr (jni_primitive_signature_table, signature[0]);
+ if (!p)
+ return -1;
+ return (p - jni_primitive_signature_table);
+}
+
+inline static jvalue
+jni_primitive_call_method (env, return_sig, object, method, params)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jobject object;
+ jmethodID method;
+ jvalue *params;
+{
+ int index = jni_lookup_primitive_call_table (return_sig);
+ return (jvalue)(*jni_primitive_call_table[index].call_method)
+ (env, object, method, params);
+}
+
+inline static jvalue
+jni_primitive_call_static_method (env, return_sig, class, method, params)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jclass class;
+ jmethodID method;
+ jvalue *params;
+{
+ int index = jni_lookup_primitive_call_table (return_sig);
+ return (jvalue)(*jni_primitive_call_table[index].call_static_method)
+ (env, class, method, params);
+}
+
+inline static jarray
+jni_primitive_new_array (env, element_sig, len)
+ JNIEnv *env;
+ const Extbyte *element_sig;
+ jsize len;
+{
+ int index = jni_lookup_primitive_call_table (element_sig);
+ return (*jni_primitive_call_table[index].new_array)
+ (env, len);
+}
+
+inline static void
+jni_primitive_set_array_element (env, element_sig, array, n, element)
+ JNIEnv *env;
+ const Extbyte *element_sig;
+ jarray array;
+ jsize n;
+ jvalue element;
+{
+ int index = jni_lookup_primitive_call_table (element_sig);
+ jni_primitive_call_table[index].set_array_element
+ (env, array, n, element);
+}
+
+inline static jvalue
+jni_primitive_get_array_element (env, element_sig, array, n)
+ JNIEnv *env;
+ const Extbyte *element_sig;
+ jarray array;
+ jsize n;
+{
+ int index = jni_lookup_primitive_call_table (element_sig);
+ return (jvalue)(*jni_primitive_call_table[index].get_array_element)
+ (env, array, n);
+}
+
+#define DEFINE_JNI_ARRAY_SET(atype,jtype,type) \
+static void jni_set_##jtype##_array_element (JNIEnv *, jarray, \
+ jsize, jvalue); \
+static void jni_set_##jtype##_array_element (JNIEnv *env, jarray array, \
+ jsize n, jvalue element) { \
+ jtype *elements; \
+ jboolean is_copy; \
+ elements = (*env)->Get##type##ArrayElements (env, (atype)array, \
+ &is_copy); \
+ elements[n] = *(jtype*)&element; \
+ if (is_copy == JNI_TRUE) \
+ (*env)->Release##type##ArrayElements \
+ (env, (atype)array, elements, 0); \
+}
+
+DEFINE_JNI_ARRAY_SET(jbooleanArray, jboolean, Boolean)
+DEFINE_JNI_ARRAY_SET(jbyteArray, jbyte, Byte)
+DEFINE_JNI_ARRAY_SET(jcharArray, jchar, Char)
+DEFINE_JNI_ARRAY_SET(jshortArray, jshort, Short)
+DEFINE_JNI_ARRAY_SET(jintArray, jint, Int)
+DEFINE_JNI_ARRAY_SET(jlongArray, jlong, Long)
+DEFINE_JNI_ARRAY_SET(jfloatArray, jfloat, Float)
+DEFINE_JNI_ARRAY_SET(jdoubleArray, jdouble, Double)
+
+#define DEFINE_JNI_ARRAY_GET(atype,jtype,type) \
+static jlong jni_get_##jtype##_array_element (JNIEnv *, jarray, jsize); \
+static jlong jni_get_##jtype##_array_element (JNIEnv *env, \
+ jarray array, jsize n) { \
+ jtype *elements; \
+ jboolean is_copy; \
+ elements = (*env)->Get##type##ArrayElements (env, (atype)array, \
+ &is_copy); \
+ return (jlong)elements[n]; \
+}
+
+DEFINE_JNI_ARRAY_GET(jbooleanArray, jboolean, Boolean)
+DEFINE_JNI_ARRAY_GET(jbyteArray, jbyte, Byte)
+DEFINE_JNI_ARRAY_GET(jcharArray, jchar, Char)
+DEFINE_JNI_ARRAY_GET(jshortArray, jshort, Short)
+DEFINE_JNI_ARRAY_GET(jintArray, jint, Int)
+DEFINE_JNI_ARRAY_GET(jlongArray, jlong, Long)
+DEFINE_JNI_ARRAY_GET(jfloatArray, jfloat, Float)
+DEFINE_JNI_ARRAY_GET(jdoubleArray, jdouble, Double)
+
+static void
+jni_initialize_primitive_call_table (env)
+ JNIEnv *env;
+{
+ jni_primitive_call_table[0].call_method =
+ (jni_method_caller)(*env)->CallBooleanMethodA;
+ jni_primitive_call_table[0].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticBooleanMethodA;
+ jni_primitive_call_table[0].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualBooleanMethodA;
+ jni_primitive_call_table[0].new_array =
+ (jni_array_allocater)(*env)->NewBooleanArray;
+ jni_primitive_call_table[0].set_array_element =
+ jni_set_jboolean_array_element;
+ jni_primitive_call_table[0].get_array_element =
+ jni_get_jboolean_array_element;
+
+ jni_primitive_call_table[1].call_method =
+ (jni_method_caller)(*env)->CallByteMethodA;
+ jni_primitive_call_table[1].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticByteMethodA;
+ jni_primitive_call_table[1].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualByteMethodA;
+ jni_primitive_call_table[1].new_array =
+ (jni_array_allocater)(*env)->NewByteArray;
+ jni_primitive_call_table[1].set_array_element =
+ jni_set_jbyte_array_element;
+ jni_primitive_call_table[1].get_array_element =
+ jni_get_jbyte_array_element;
+
+ jni_primitive_call_table[2].call_method =
+ (jni_method_caller)(*env)->CallCharMethodA;
+ jni_primitive_call_table[2].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticCharMethodA;
+ jni_primitive_call_table[2].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualCharMethodA;
+ jni_primitive_call_table[2].new_array =
+ (jni_array_allocater)(*env)->NewCharArray;
+ jni_primitive_call_table[2].set_array_element =
+ jni_set_jchar_array_element;
+ jni_primitive_call_table[2].get_array_element =
+ jni_get_jchar_array_element;
+
+ jni_primitive_call_table[3].call_method =
+ (jni_method_caller)(*env)->CallShortMethodA;
+ jni_primitive_call_table[3].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticShortMethodA;
+ jni_primitive_call_table[3].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualShortMethodA;
+ jni_primitive_call_table[3].new_array =
+ (jni_array_allocater)(*env)->NewShortArray;
+ jni_primitive_call_table[3].set_array_element =
+ jni_set_jshort_array_element;
+ jni_primitive_call_table[3].get_array_element =
+ jni_get_jshort_array_element;
+
+ jni_primitive_call_table[4].call_method =
+ (jni_method_caller)(*env)->CallIntMethodA;
+ jni_primitive_call_table[4].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticIntMethodA;
+ jni_primitive_call_table[4].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualIntMethodA;
+ jni_primitive_call_table[4].new_array =
+ (jni_array_allocater)(*env)->NewIntArray;
+ jni_primitive_call_table[4].set_array_element =
+ jni_set_jint_array_element;
+ jni_primitive_call_table[4].get_array_element =
+ jni_get_jint_array_element;
+
+ jni_primitive_call_table[5].call_method =
+ (jni_method_caller)(*env)->CallLongMethodA;
+ jni_primitive_call_table[5].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticLongMethodA;
+ jni_primitive_call_table[5].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualLongMethodA;
+ jni_primitive_call_table[5].new_array =
+ (jni_array_allocater)(*env)->NewLongArray;
+ jni_primitive_call_table[5].set_array_element =
+ jni_set_jlong_array_element;
+ jni_primitive_call_table[5].get_array_element =
+ jni_get_jlong_array_element;
+
+ jni_primitive_call_table[6].call_method =
+ (jni_method_caller)(*env)->CallFloatMethodA;
+ jni_primitive_call_table[6].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticFloatMethodA;
+ jni_primitive_call_table[6].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualFloatMethodA;
+ jni_primitive_call_table[6].new_array =
+ (jni_array_allocater)(*env)->NewFloatArray;
+ jni_primitive_call_table[6].set_array_element =
+ jni_set_jfloat_array_element;
+ jni_primitive_call_table[6].get_array_element =
+ jni_get_jfloat_array_element;
+
+ jni_primitive_call_table[7].call_method =
+ (jni_method_caller)(*env)->CallDoubleMethodA;
+ jni_primitive_call_table[7].call_static_method =
+ (jni_static_method_caller)(*env)->CallStaticDoubleMethodA;
+ jni_primitive_call_table[7].call_nonvirtual_method =
+ (jni_nonvirtual_method_caller)(*env)->CallNonvirtualDoubleMethodA;
+ jni_primitive_call_table[7].new_array =
+ (jni_array_allocater)(*env)->NewDoubleArray;
+ jni_primitive_call_table[7].set_array_element =
+ jni_set_jdouble_array_element;
+ jni_primitive_call_table[7].get_array_element =
+ jni_get_jdouble_array_element;
+}
+
+static jobjectArray
+jni_class_get_methods (env, class)
+ JNIEnv *env;
+ jclass class;
+{
+ jclass clazz = (*env)->GetObjectClass (env, class);
+ jmethodID method = (*env)->GetMethodID (env, clazz, "getMethods",
+ "()[Ljava/lang/reflect/Method;");
+ return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL);
+}
+
+static jobjectArray
+jni_class_get_constructors (env, class)
+ JNIEnv *env;
+ jclass class;
+{
+ jclass clazz = (*env)->GetObjectClass (env, class);
+ jmethodID method = (*env)->GetMethodID (env, clazz, "getConstructors",
+ "()[Ljava/lang/reflect/Constructor;");
+ return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL);
+}
+
+static jstring
+jni_class_get_name (env, class)
+ JNIEnv *env;
+ jclass class;
+{
+ jclass clazz = (*env)->GetObjectClass (env, class);
+ jmethodID method = (*env)->GetMethodID (env, clazz, "getName",
+ "()Ljava/lang/String;");
+ return (jstring) (*env)->CallObjectMethod (env, class, method, NULL);
+}
+
+static jboolean
+jni_class_is_primitive (env, class)
+ JNIEnv *env;
+ jclass class;
+{
+ jclass clazz = (*env)->GetObjectClass (env, class);
+ jmethodID method = (*env)->GetMethodID (env, clazz, "isPrimitive",
+ "()Z");
+ return (*env)->CallBooleanMethod (env, class, method, NULL);
+}
+
+static jobjectArray
+jni_method_get_parameter_types (env, method)
+ JNIEnv *env;
+ jobject method;
+{
+ jclass class = (*env)->GetObjectClass (env, method);
+ jmethodID get_parameter_types =
+ (*env)->GetMethodID (env, class, "getParameterTypes",
+ "()[Ljava/lang/Class;");
+ return (jobjectArray) (*env)->CallObjectMethod
+ (env, method, get_parameter_types, NULL);
+}
+
+static jstring
+jni_method_get_name (env, method)
+ JNIEnv *env;
+ jobject method;
+{
+ jclass class = (*env)->GetObjectClass (env, method);
+ jmethodID get_name =
+ (*env)->GetMethodID (env, class, "getName", "()Ljava/lang/String;");
+ return (jstring) (*env)->CallObjectMethod (env, method, get_name, NULL);
+}
+
+static jint
+jni_method_get_modifiers (env, method)
+ JNIEnv *env;
+ jobject method;
+{
+ jclass class = (*env)->GetObjectClass (env, method);
+ jmethodID get_modifiers =
+ (*env)->GetMethodID (env, class, "getModifiers", "()I");
+ return (*env)->CallIntMethod (env, method, get_modifiers, NULL);
+}
+
+static jclass
+jni_method_get_return_type (env, method)
+ JNIEnv *env;
+ jobject method;
+{
+ jclass class = (*env)->GetObjectClass (env, method);
+ jmethodID get_return_type =
+ (*env)->GetMethodID (env, class, "getReturnType", "()Ljava/lang/Class;");
+ return (jclass) (*env)->CallObjectMethod
+ (env, method, get_return_type, NULL);
+}
+
+static jboolean
+jni_modifier_is_static (env, modifiers)
+ JNIEnv *env;
+ jint modifiers;
+{
+ static jclass class = NULL;
+ jmethodID is_static;
+
+ if (!class)
+ class = (*env)->FindClass (env, "java/lang/reflect/Modifier");
+ is_static = (*env)->GetStaticMethodID (env, class, "isStatic", "(I)Z");
+ return (*env)->CallStaticBooleanMethod (env, class, is_static, modifiers);
+}
+
+static jboolean
+jni_modifier_is_non_static (env, modifiers)
+ JNIEnv *env;
+ jint modifiers;
+{
+ if (jni_modifier_is_static (env, modifiers) == JNI_TRUE)
+ return JNI_FALSE;
+ return JNI_TRUE;
+}
+
+static void
+jni_check_exception (env)
+ JNIEnv *env;
+{
+ jthrowable throwable;
+
+ throwable = (*env)->ExceptionOccurred (env);
+ if (!throwable)
+ return;
+
+ (*env)->ExceptionClear (env);
+ error ("Exception occurred.");
+}
+
+static jvalue
+jni_call_static_method (env, return_sig, class, method, params)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jclass class;
+ jmethodID method;
+ jvalue *params;
+{
+ jthrowable throwable;
+ jvalue value;
+
+ switch (return_sig[0])
+ {
+ case 'V':
+ (*env)->CallStaticVoidMethodA (env, class, method, params);
+ value.l = NULL;
+ case 'L': case '[':
+ value = (jvalue)(*env)->CallStaticObjectMethodA
+ (env, class, method, params);
+ break;
+ default:
+ value = jni_primitive_call_static_method (env, return_sig, class,
+ method, params);
+ break;
+ }
+
+ return value;
+}
+
+static jvalue
+jni_call_virtual_method (env, return_sig, object, method, params)
+ JNIEnv *env;
+ const Extbyte *return_sig;
+ jobject object;
+ jmethodID method;
+ jvalue *params;
+{
+ jthrowable throwable;
+ jvalue value;
+
+ switch (return_sig[0])
+ {
+ case 'V':
+ (*env)->CallVoidMethodA (env, object, method, params);
+ value.l = NULL;
+ case 'L': case '[':
+ value = (jvalue)(*env)->CallObjectMethodA (env, object, method, params);
+ break;
+ default:
+ value = jni_primitive_call_method (env, return_sig, object, method,
+ params);
+ break;
+ }
+
+ return value;
+}
+
+
+void
+syms_of_java (void)
+{
+ INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaclass);
+ INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaobject);
+ defsymbol (&Qjava, "java");
+
+ defsymbol (&Qjavaclassp, "javaclassp");
+ defsymbol (&Qjavaobjectp, "javaobjectp");
+
+ DEFSUBR (Fjava_find_class);
+ DEFSUBR (Fjava_call_virtual_method);
+ DEFSUBR (Fjava_call_static_method);
+ DEFSUBR (Fjava_make_object);
+ DEFSUBR (Fjava_class_list);
+ DEFSUBR (Fjava_class_name);
+}
+
+void
+vars_of_java (void)
+{
+ char *p;
+
+ Fprovide (Qjava);
+
+ DEFVAR_LISP ("java-coding-system", &Vjava_coding_system /*
+Default Java Vartual Machine coding system.
+*/);
+ Vjava_coding_system = Qnative;
+
+ DEFVAR_LISP ("java-class-path", &Vjava_class_path /*
+Default class path.
+*/);
+ p = getenv ("CLASSPATH");
+ if (!p)
+ Vjava_class_path = Qnil;
+ else
+ Vjava_class_path = build_ext_string (p, JAVA_OS_CODING);
+
+ initialize_javavm ();
+
+ staticpro (&Vjava_class_hash_table);
+ Vjava_class_hash_table =
+ make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+}
projects / elisp / xemacs-java.git / commitdiff