java.c

   1 /* Emacs Lisp binding to Java Native Interface.
   2    Copyright (C) 2000 Daiki Ueno.
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include <emodules.h>
  22 #include <elhash.h>
  23 #include "java.h"
  24
  25 #ifdef MULE
  26 #define JAVA_OS_CODING Fget_coding_system(Vjava_coding_system)
  27 #else
  28 #define JAVA_OS_CODING Qnative
  29 #endif
  30
  31 Lisp_Object Vjava_coding_system;
  32 Lisp_Object Vjava_class_path;
  33 Lisp_Object Vjava_library_path;
  34 static Lisp_Object Qjava;
  35
  36 Lisp_Object Qjavaclassp;
  37 Lisp_Object Qjavaobjectp;
  38
  39 static JavaVM *java_jvm = NULL;
  40 static JNIEnv *java_env = NULL;
  41
  42 #define JAVAVM_LIVE_P() (java_jvm && java_env)
  43 #define CHECK_LIVE_JAVAVM() do { \
  44   if (!JAVAVM_LIVE_P ()) \
  45     error ("Attempting to access uninitialized Java VM.\n"); \
  46 } while (0)
  47
  48 static Extbyte *java_build_property_string (Lisp_Object, Lisp_Object);
  49 static void java_dots_to_slashes (Extbyte *);
  50 static int java_unify_parameter (JNIEnv *, const Extbyte *, Lisp_Object,
  51                                  jvalue *);
  52 static Lisp_Object java_build_return_value (JNIEnv *, const Extbyte *, jvalue);
  53
  54 typedef jlong (JNICALL *jni_method_caller)
  55      (JNIEnv *, jobject, jmethodID, jvalue *);
  56
  57 typedef jlong (JNICALL *jni_static_method_caller)
  58      (JNIEnv *, jclass, jmethodID, jvalue *);
  59
  60 typedef jlong (JNICALL *jni_nonvirtual_method_caller)
  61      (JNIEnv *, jobject, jclass, jmethodID, jvalue *);
  62
  63 typedef jarray (JNICALL *jni_array_allocater) (JNIEnv *, jsize);
  64
  65 typedef void (*jni_array_setter) (JNIEnv *, jarray, jsize, jvalue);
  66 typedef jlong (*jni_array_referrer) (JNIEnv *, jarray, jsize);
  67
  68 struct jni_primitive_wrapper {
  69   jni_method_caller call_method;
  70   jni_static_method_caller call_static_method;
  71   jni_nonvirtual_method_caller call_nonvirtual_method;
  72   jni_array_allocater new_array;
  73   jni_array_setter set_array_element;
  74   jni_array_referrer get_array_element;
  75 };
  76
  77 typedef jboolean (*java_modifier_filter)(JNIEnv *, jint);
  78
  79 struct java_class_list_closure
  80 {
  81   Lisp_Object *java_class_list;
  82 };
  83
  84 static struct jni_primitive_wrapper jni_primitive_call_table[8];
  85 static const Extbyte *jni_primitive_signature_table = "ZBCSIJFD";
  86
  87 inline static jvalue jni_primitive_call_method
  88   (JNIEnv *, const Extbyte *, jobject, jmethodID, jvalue *);
  89 inline static jvalue jni_primitive_call_static_method
  90   (JNIEnv *, const Extbyte *, jclass, jmethodID, jvalue *);
  91 inline static jarray jni_primitive_new_array
  92   (JNIEnv *, const Extbyte *, jsize);
  93 inline static void jni_primitive_set_array_element
  94   (JNIEnv *, const Extbyte *, jarray, jsize, jvalue);
  95 inline static jvalue jni_primitive_get_array_element
  96   (JNIEnv *, const Extbyte *, jarray, jsize);
  97
  98 static void jni_initialize_primitive_call_table (JNIEnv *);
  99 static int jni_lookup_primitive_call_table (const char *);
 100 static jobjectArray jni_class_get_methods (JNIEnv *, jclass);
 101 static jobjectArray jni_class_get_constructors (JNIEnv *, jclass);
 102 static jstring jni_class_get_name (JNIEnv *, jclass class);
 103 static jboolean jni_class_is_primitive (JNIEnv *, jclass);
 104 static jobjectArray jni_method_get_parameter_types (JNIEnv *, jobject);
 105 static jstring jni_method_get_name (JNIEnv *, jobject);
 106 static jint jni_method_get_modifiers (JNIEnv *, jobject);
 107 static jclass jni_method_get_return_type (JNIEnv *, jobject);
 108 static jboolean jni_modifier_is_static (JNIEnv *, jint);
 109 static jboolean jni_modifier_is_non_static (JNIEnv *, jint);
 110 static void jni_check_exception (JNIEnv *);
 111 static jvalue jni_call_static_method (JNIEnv *, const Extbyte *,
 112                                       jclass, jmethodID, jvalue *);
 113 static jvalue jni_call_virtual_method (JNIEnv *, const Extbyte *,
 114                                        jobject, jmethodID, jvalue *);
 115
 116 static Lisp_Object Vjava_class_hash_table;
 117
 118 static void
 119 initialize_javavm (void)
 120 {
 121   JavaVMInitArgs vm_args;
 122   JavaVMOption options[2];
 123   jint noptions = 0, status;
 124
 125   options[0].optionString = "abort";
 126   options[0].extraInfo = abort;
 127
 128   if (!NILP (Vjava_class_path))
 129     {
 130       CHECK_STRING (Vjava_class_path);
 131
 132       options[noptions++].optionString =
 133         java_build_property_string (build_string ("java.class.path"),
 134                                     Vjava_class_path);
 135     }
 136
 137   vm_args.version = JNI_VERSION_1_2;
 138   vm_args.options = options;
 139   vm_args.nOptions = noptions;
 140   vm_args.ignoreUnrecognized = JNI_TRUE;
 141
 142   status = JNI_CreateJavaVM (&java_jvm, (void **)&java_env, &vm_args);
 143   if (status < 0)
 144     error ("Can't create Java VM. Error: %ld\n", status);
 145
 146   jni_initialize_primitive_call_table (java_env);
 147 }
 148
 149 static void
 150 finalize_javavm (void)
 151 {
 152   (*java_jvm)->DestroyJavaVM (java_jvm);
 153   java_jvm = NULL;
 154   java_env = NULL;
 155 }
 156
 157 static Lisp_Object
 158 make_javaclass (Lisp_JavaClass *javaclass)
 159 {
 160   Lisp_Object lisp_javaclass;
 161   XSETJAVACLASS (lisp_javaclass, javaclass);
 162   return lisp_javaclass;
 163 }
 164
 165 static Lisp_Object
 166 mark_javaclass (Lisp_Object obj)
 167 {
 168   Lisp_JavaClass *javaclass = XJAVACLASS (obj);
 169   return javaclass->name;
 170 }
 171
 172 static void
 173 print_javaclass (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 174 {
 175   Lisp_JavaClass *javaclass;
 176   char buf[256];
 177
 178   javaclass = XJAVACLASS (obj);
 179
 180   if (NILP (javaclass->name))
 181     strcpy (buf, "#<javaclass>");
 182   else
 183     sprintf (buf, "#<javaclass \"%s\">", XSTRING_DATA (javaclass->name));
 184   write_c_string (buf, printcharfun);
 185 }
 186
 187 static Lisp_JavaClass *
 188 allocate_javaclass (void)
 189 {
 190   Lisp_JavaClass *javaclass = alloc_lcrecord_type (Lisp_JavaClass,
 191                                                    &lrecord_javaclass);
 192
 193   javaclass->class = (jclass)NULL;
 194   javaclass->name = Qnil;
 195   return javaclass;
 196 }
 197
 198 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaclass", javaclass,
 199                                         mark_javaclass, print_javaclass, NULL,
 200                                         NULL, NULL,
 201                                         0,
 202                                         Lisp_JavaClass);
 203
 204 static Lisp_Object
 205 make_javaobject (Lisp_JavaObject *javaobject)
 206 {
 207   Lisp_Object lisp_javaobject;
 208   XSETJAVAOBJECT (lisp_javaobject, javaobject);
 209   return lisp_javaobject;
 210 }
 211
 212 static Lisp_Object
 213 mark_javaobject (Lisp_Object obj)
 214 {
 215   Lisp_JavaObject *javaobject = XJAVAOBJECT (obj);
 216   return javaobject->signature;
 217 }
 218
 219 static void
 220 print_javaobject (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 221 {
 222   Lisp_JavaObject *javaobject;
 223   char buf[256];
 224
 225   javaobject = XJAVAOBJECT (obj);
 226
 227   if (NILP (javaobject->signature))
 228     strcpy (buf, "#<javaobject>");
 229   else
 230     sprintf (buf, "#<javaobject \"%s\">",
 231              XSTRING_DATA (javaobject->signature));
 232   write_c_string (buf, printcharfun);
 233 }
 234
 235 static Lisp_JavaObject *
 236 allocate_javaobject (void)
 237 {
 238   Lisp_JavaObject *javaobject;
 239
 240   javaobject = alloc_lcrecord_type (Lisp_JavaObject, &lrecord_javaobject);
 241   javaobject->object = (jobject)NULL;
 242   javaobject->signature = Qnil;
 243   return javaobject;
 244 }
 245
 246 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaobject", javaobject,
 247                                         mark_javaobject, print_javaobject,
 248                                         NULL, NULL, NULL,
 249                                         0,
 250                                         Lisp_JavaObject);
 251
 252 DEFUN ("java-initialize", Fjava_initialize, 0, 0, 0, /*
 253 Initialize the Java Virtual Machine.
 254 */
 255        ())
 256 {
 257   if (JAVAVM_LIVE_P ())
 258     return Qnil;
 259
 260   initialize_javavm ();
 261   if (JAVAVM_LIVE_P ())
 262     return Qt;
 263
 264   return Qnil; /* not reached */
 265 }
 266
 267 DEFUN ("java-finalize", Fjava_finalize, 0, 0, 0, /*
 268 Finalize the Java Virtual Machine.
 269 */
 270        ())
 271 {
 272   CHECK_LIVE_JAVAVM ();
 273   finalize_javavm ();
 274
 275   return Qnil;
 276 }
 277
 278 DEFUN ("java-find-class", Fjava_find_class, 1, 1, 0, /*
 279 Find class by name.
 280 */
 281        (name))
 282 {
 283   char *c_name;
 284   jclass clazz;
 285   Lisp_JavaClass *javaclass;
 286   Lisp_Object class;
 287
 288   CHECK_LIVE_JAVAVM ();
 289   CHECK_STRING (name);
 290
 291   class = Fgethash (name, Vjava_class_hash_table, Qnil);
 292   if (JAVACLASSP (class))
 293     return class;
 294
 295   TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
 296   java_dots_to_slashes (c_name);
 297   clazz = (*java_env)->FindClass (java_env, c_name);
 298   if (!clazz)
 299     error ("Can't locate the %s class", XSTRING_DATA (name));
 300
 301   javaclass = allocate_javaclass ();
 302   javaclass->class = clazz;
 303   javaclass->name = name;
 304
 305   class = make_javaclass (javaclass);
 306   Fputhash (javaclass->name, class, Vjava_class_hash_table);
 307   return class;
 308 }
 309
 310 static Extbyte *
 311 java_build_property_string (name, value)
 312      Lisp_Object name, value;
 313 {
 314   const Extbyte *c_name, *c_value;
 315   Extbyte *c_property;
 316
 317   TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
 318   TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, c_value, Qnative);
 319
 320   c_property = xmalloc (strlen (c_name) + strlen (c_value) + 4);
 321   sprintf (c_property, "-D%s=%s", c_name, c_value);
 322
 323   return c_property;
 324 }
 325
 326 static void
 327 java_dots_to_slashes (c_class)
 328      Extbyte *c_class;
 329 {
 330   const Extbyte *end;
 331
 332   for (end = c_class + strlen (c_class); c_class < end; c_class++)
 333     if (*c_class == '.')
 334       *c_class = '/';
 335 }
 336
 337 inline static Extbyte *
 338 java_primitive_type_signature (name)
 339      const Extbyte *name;
 340 {
 341   if (!strncmp (name, "boolean", 7))
 342     return "Z";
 343   else if (!strncmp (name, "byte", 4))
 344     return "B";
 345   else if (!strncmp (name, "char", 4))
 346     return "C";
 347   else if (!strncmp (name, "short", 5))
 348     return "S";
 349   else if (!strncmp (name, "int", 3))
 350     return "I";
 351   else if (!strncmp (name, "long", 4))
 352     return "J";
 353   else if (!strncmp (name, "float", 5))
 354     return "F";
 355   else if (!strncmp (name, "double", 6))
 356     return "D";
 357   else if (!strncmp (name, "void", 4))
 358     return "V";
 359 }
 360
 361 static const Extbyte *
 362 java_type_signature (env, class)
 363      JNIEnv *env;
 364      jclass class;
 365 {
 366   jstring string = jni_class_get_name (env, class);
 367   const Extbyte *utf_string, *signature;
 368   Extbyte *buf;
 369   jboolean is_copy;
 370
 371   utf_string = (*env)->GetStringUTFChars (env, string, &is_copy);
 372
 373   if (jni_class_is_primitive (env, class))
 374     signature = java_primitive_type_signature (utf_string);
 375   else if (utf_string[0] == '[')
 376     {
 377       signature = buf = xstrdup (utf_string);
 378       java_dots_to_slashes (buf);
 379     }
 380   else
 381     {
 382       signature = buf = xmalloc (strlen (utf_string) + 3);
 383       sprintf (buf, "L%s;", utf_string);
 384       java_dots_to_slashes (buf);
 385     }
 386   if (is_copy == JNI_TRUE)
 387     (*env)->ReleaseStringUTFChars (env, string, utf_string);
 388
 389   return signature;
 390 }
 391
 392 static jarray
 393 java_unify_primitive_array (env, element_sig, obj)
 394      JNIEnv *env;
 395      const Extbyte *element_sig;
 396      Lisp_Object obj;
 397 {
 398   int i, index, len = XVECTOR_LENGTH (obj);
 399   Lisp_Object *data = XVECTOR_DATA (obj);
 400   jarray array;
 401
 402   array = jni_primitive_new_array (env, element_sig, len);
 403
 404   for (i = 0; i<len; i++)
 405     {
 406       jvalue param;
 407       if (!java_unify_parameter (env, element_sig, data[i], &param))
 408         return NULL;
 409       jni_primitive_set_array_element (env, element_sig, array, i, param);
 410     }
 411   return array;
 412 }
 413
 414 static jarray
 415 java_unify_object_array (env, element_sig, obj)
 416      JNIEnv *env;
 417      const Extbyte *element_sig;
 418      Lisp_Object obj;
 419 {
 420   int i, index, len = XVECTOR_LENGTH (obj);
 421   Lisp_Object *data = XVECTOR_DATA (obj);
 422   jarray array;
 423   int element_sig_len = strlen (element_sig);
 424   Extbyte *name = xstrdup (element_sig + 1);
 425   Lisp_Object class;
 426
 427   name[element_sig_len - 2] = '\0'; /* remove the last ";" */
 428   class = Fjava_find_class (build_string (name));
 429   array = (*env)->NewObjectArray (env, len, XJAVACLASS (class)->class, NULL);
 430   xfree (name);
 431
 432   name = alloca (element_sig_len + 1);
 433   strncpy (name, element_sig, element_sig_len);
 434   name[element_sig_len] = '\0';
 435   for (i = 0; i<len; i++)
 436     {
 437       jvalue param;
 438       if (!java_unify_parameter (env, name, data[i], &param))
 439         return NULL;
 440       (*env)->SetObjectArrayElement (env, array, i, param.l);
 441     }
 442   return array;
 443 }
 444
 445 /* Convert a Lisp object into a Java object according to PARAM_SIG. */
 446 static int
 447 java_unify_parameter (env, param_sig, obj, param)
 448      JNIEnv *env;
 449      const Extbyte *param_sig;
 450      Lisp_Object obj;
 451      jvalue *param;
 452 {
 453   switch (param_sig[0])
 454     {
 455     case 'Z':
 456       param->z = NILP (obj) ? JNI_FALSE : JNI_TRUE;
 457       break;
 458     case 'B':
 459       if (!INTP (obj))
 460         return 0;
 461       param->b = (jshort) XINT (obj);
 462       break;
 463     case 'C':
 464       if (CHARP (obj))
 465         {
 466           obj = Fchar_ucs (obj);
 467           if (!INTP(obj))
 468             return 0;
 469           param->c = (jchar) XINT (obj);
 470         }
 471       break;
 472     case 'S':
 473       if (!INTP (obj))
 474         return 0;
 475       param->s = (jshort) XINT (obj);
 476       break;
 477     case 'I':
 478       if (!INTP (obj))
 479         return 0;
 480       param->i = (jint) XINT (obj);
 481       break;
 482     case 'J':
 483       if (!INTP (obj))
 484         return 0;
 485       param->j = (jlong) XINT (obj);
 486       break;
 487     case 'F':
 488       if (!INT_OR_FLOATP (obj))
 489         return 0;
 490       param->f = (jfloat) XFLOATINT (obj);
 491       break;
 492     case 'D':
 493       if (!INT_OR_FLOATP (obj))
 494         return 0;
 495       param->d = (jdouble) XFLOATINT (obj);
 496       break;
 497     case 'L':
 498       if (!JAVAOBJECTP (obj) && !STRINGP (obj)
 499           || strncmp (param_sig, "Ljava/lang/String;", 18))
 500         return 0;
 501       if (JAVAOBJECTP (obj))
 502         param->l = XJAVAOBJECT (obj)->object;
 503       else if (STRINGP (obj))
 504         {
 505           const Extbyte *c_string;
 506           TO_EXTERNAL_FORMAT (LISP_STRING, obj, C_STRING_ALLOCA,
 507                               c_string, Qnative);
 508           param->l = (jobject) (*env)->NewStringUTF (env, c_string);
 509         }
 510       break;
 511     case '[':
 512       if (!VECTORP (obj) && !BIT_VECTORP (obj)
 513           || !strncmp (param_sig, "[Z", 2))
 514         return 0;
 515       if (BIT_VECTORP (obj))
 516         obj = vconcat2 (obj, Qnil);
 517       if (param_sig[1] == 'L')
 518         param->l = java_unify_object_array (env, param_sig+1, obj);
 519       else
 520         param->l = java_unify_primitive_array (env, param_sig+1, obj);
 521       if (!param->l)
 522         return 0;
 523       break;
 524     }
 525   return 1;
 526 }
 527
 528 static const Extbyte *
 529 java_unify_parameters (env, ptypes, nargs, args, params)
 530      JNIEnv *env;
 531      int nargs;
 532      jobjectArray ptypes;
 533      Lisp_Object *args;
 534      jvalue *params;
 535 {
 536   int i, bufsize = 128, nptypes = (*env)->GetArrayLength (env, ptypes);
 537   char *p, *buf = xmalloc_and_zero (bufsize);
 538
 539   for (p = buf, i = 0; i < nptypes; i++)
 540     {
 541       jclass element = (*env)->GetObjectArrayElement (env, ptypes, i);
 542       const Extbyte *param_sig = java_type_signature (env, element);
 543       int len = strlen (param_sig);
 544       (*env)->DeleteLocalRef (env, element);
 545       if (!java_unify_parameter (env, param_sig, args[i], &params[i]))
 546         {
 547           xfree (buf);
 548           return NULL;
 549         }
 550
 551       while ((buf - p) + len > bufsize)
 552         {
 553           bufsize *= 2;
 554           buf = xrealloc (buf, bufsize);
 555         }
 556
 557       strncpy (buf, param_sig, len);
 558     }
 559   return buf;
 560 }
 561
 562 static Lisp_Object
 563 java_build_return_value_vector (env, return_sig, array)
 564      JNIEnv *env;
 565      const Extbyte *return_sig;
 566      jarray array;
 567 {
 568   jint len = (*env)->GetArrayLength (env, array);
 569   Lisp_Object v = make_vector (len, Qnil);
 570   int i;
 571   Extbyte *name = xstrdup (return_sig);
 572   jvalue element;
 573
 574   if (name[0] == 'L' || name[0] == '[')
 575     for (i = 0; i<len; i++)
 576       {
 577         element.l = (*env)->GetObjectArrayElement (env, array, i);
 578         Faset (v, make_int (i), java_build_return_value (env, name, element));
 579       }
 580   else
 581     for (i = 0; i<len; i++)
 582       {
 583         element = jni_primitive_get_array_element (env, name, array, i);
 584         Faset (v, make_int (i), java_build_return_value (env, name, element));
 585       }
 586   xfree (name);
 587   return v;
 588 }
 589
 590 /* Convert a Java object into a Lisp object according to RETURN_SIG. */
 591 static Lisp_Object
 592 java_build_return_value (env, return_sig, value)
 593      JNIEnv *env;
 594      const Extbyte *return_sig;
 595      jvalue value;
 596 {
 597   switch (return_sig[0])
 598     {
 599     case 'Z':
 600       return value.z ? Qt : Qnil;
 601     case 'B':
 602       return make_int (value.b);
 603     case 'C':
 604       {
 605         Lisp_Object ucs = make_int (value.c);
 606         return Fucs_char (ucs);
 607       }
 608     case 'S':
 609       return make_int (value.s);
 610     case 'I':
 611       return make_int (value.i);
 612     case 'J':
 613       return make_int (value.j);
 614     case 'F':
 615       return make_float (value.f);
 616     case 'D':
 617       return make_float (value.d);
 618     case 'L':
 619       if (!strncmp (return_sig, "Ljava/lang/String;", 18))
 620         {
 621           const Extbyte *utf_string;
 622           jboolean is_copy;
 623           Lisp_Object string;
 624
 625           if (!value.l)
 626             return Qnil;
 627           utf_string = (*env)->GetStringUTFChars (env, value.l, &is_copy);
 628           string = build_ext_string (utf_string, JAVA_OS_CODING);
 629           if (is_copy == JNI_TRUE)
 630             (*env)->ReleaseStringUTFChars (env, value.l, utf_string);
 631
 632           return string;
 633         }
 634       else {
 635         Lisp_JavaObject *javaobject;
 636
 637         javaobject = allocate_javaobject ();
 638         javaobject->object = value.l;
 639         javaobject->signature = build_string (return_sig);
 640
 641         return make_javaobject (javaobject);
 642       }
 643       break;
 644     case '[':
 645       return java_build_return_value_vector (env, return_sig+1, value.l);
 646     }
 647
 648   error ("Can't cast the return value.");
 649
 650   return Qnil;
 651 }
 652
 653 static jobject
 654 java_find_method (env, methods, c_method_to_invoke,
 655                   nargs, args, params, filter)
 656      JNIEnv *env;
 657      jobjectArray methods;
 658      const Extbyte *c_method_to_invoke;
 659      int nargs;
 660      Lisp_Object *args;
 661      jvalue *params;
 662      java_modifier_filter filter;
 663 {
 664   jobject method = NULL;
 665   jint nmethods;
 666   int i;
 667
 668   nmethods = (*env)->GetArrayLength (env, methods);
 669   for (i = 0; i < nmethods; i++)
 670     {
 671       jobject element =
 672         (*env)->GetObjectArrayElement (env, methods, i);
 673       jint modifiers = jni_method_get_modifiers (env, element);
 674       jobjectArray ptypes;
 675       int nptypes;
 676       jstring name = jni_method_get_name (env, element);
 677       const Extbyte *utf_name, *param_sig;
 678       jboolean is_copy;
 679
 680       utf_name = (*java_env)->GetStringUTFChars (env, name, &is_copy);
 681
 682       if (c_method_to_invoke && strcmp (utf_name, c_method_to_invoke))
 683         goto retry;
 684       if (filter && (*filter) (env, modifiers) != JNI_TRUE)
 685         goto retry;
 686
 687       ptypes = jni_method_get_parameter_types (env, element);
 688       nptypes = (*env)->GetArrayLength (env, ptypes);
 689
 690       if (nptypes != nargs)
 691         goto retry;
 692
 693       param_sig = java_unify_parameters (env, ptypes, nargs, args, params);
 694       if (!param_sig)
 695         goto retry;
 696
 697       method = element;
 698       break;
 699
 700     retry:
 701       if (is_copy == JNI_TRUE)
 702         (*env)->ReleaseStringUTFChars (env, name, utf_name);
 703       (*env)->DeleteLocalRef (env, element);
 704     }
 705   return method;
 706 }
 707
 708 static Lisp_Object
 709 java_call_static_method (obj, name, nargs, args)
 710      Lisp_Object obj, name, *args;
 711      int nargs;
 712 {
 713   jclass class, return_type;
 714   jobjectArray methods;
 715   jobject method;
 716   jvalue *params, value;
 717   jmethodID method_id;
 718   Extbyte *c_name;
 719   const Extbyte *return_sig;
 720   java_modifier_filter filter;
 721
 722   /* Prepare for the static method call. */
 723   class = XJAVACLASS (obj)->class;
 724   filter = jni_modifier_is_static;
 725   params = alloca (sizeof (jvalue) * nargs);
 726
 727   /* Do unification in the ordinary way.
 728      This part can be commonly used and should be split off. */
 729   methods = jni_class_get_methods (java_env, class);
 730   TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
 731   method = java_find_method (java_env, methods, c_name, nargs, args, params,
 732                              filter);
 733   if (!method)
 734     error ("Bad method name: %s", XSTRING_DATA (name));
 735
 736   method_id = (*java_env)->FromReflectedMethod (java_env, method);
 737   return_type = jni_method_get_return_type (java_env, method);
 738   return_sig = java_type_signature (java_env, return_type);
 739   (*java_env)->DeleteLocalRef (java_env, method);
 740
 741   value = jni_call_static_method (java_env, return_sig, class, method_id,
 742                                   params);
 743
 744   /* Clean up returned value.
 745      This part can be commonly used and should be split off. */
 746   jni_check_exception (java_env);
 747   if (!value.l)                 /* possibly null or void */
 748     return Qnil;
 749   return java_build_return_value (java_env, return_sig, value);
 750 }
 751
 752 static Lisp_Object
 753 java_call_virtual_method (obj, name, nargs, args)
 754      Lisp_Object obj, name, *args;
 755      int nargs;
 756 {
 757   jclass class, return_type;
 758   jobjectArray methods;
 759   jobject object, method;
 760   jvalue *params, value;
 761   jmethodID method_id;
 762   Extbyte *c_name;
 763   const Extbyte *return_sig;
 764   java_modifier_filter filter;
 765
 766   /* Prepare for the virtual method call. */
 767   object = XJAVAOBJECT (obj)->object;
 768   class = (*java_env)->GetObjectClass (java_env, object);
 769   filter = jni_modifier_is_non_static;
 770   params = alloca (sizeof (jvalue) * nargs);
 771
 772   /* Do unification.
 773      This part can be commonly used and should be split off. */
 774   methods = jni_class_get_methods (java_env, class);
 775   TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative);
 776   method = java_find_method (java_env, methods, c_name, nargs, args, params,
 777                              filter);
 778   if (!method)
 779     error ("Bad method name: %s", XSTRING_DATA (name));
 780
 781   method_id = (*java_env)->FromReflectedMethod (java_env, method);
 782   return_type = jni_method_get_return_type (java_env, method);
 783   return_sig = java_type_signature (java_env, return_type);
 784   (*java_env)->DeleteLocalRef (java_env, method);
 785
 786   value = jni_call_virtual_method (java_env, return_sig, object, method_id,
 787                                    params);
 788
 789   /* Clean up returned value.
 790      This part can be commonly used and should be split off. */
 791   jni_check_exception (java_env);
 792   if (!value.l)                 /* possibly null or void */
 793     return Qnil;
 794   return java_build_return_value (java_env, return_sig, value);
 795 }
 796
 797 DEFUN ("java-call-static-method", Fjava_call_static_method, 2, MANY, 0, /*
 798 Call static method.
 799 */
 800        (int nargs, Lisp_Object *args))
 801 {
 802   Lisp_Object class = args[0];
 803   Lisp_Object method = args[1];
 804   java_modifier_filter filter;
 805
 806   CHECK_JAVACLASS (class);
 807   CHECK_STRING (method);
 808   CHECK_LIVE_JAVAVM ();
 809
 810   return java_call_static_method (class, method, nargs - 2, args + 2);
 811 }
 812
 813 DEFUN ("java-call-virtual-method", Fjava_call_virtual_method, 2, MANY, 0, /*
 814 Call static method.
 815 */
 816        (int nargs, Lisp_Object *args))
 817 {
 818   Lisp_Object object = args[0];
 819   Lisp_Object method = args[1];
 820
 821   CHECK_JAVAOBJECT (object);
 822   CHECK_STRING (method);
 823   CHECK_LIVE_JAVAVM ();
 824
 825   return java_call_virtual_method (object, method, nargs - 2, args + 2);
 826 }
 827
 828 static Lisp_Object
 829 java_make_object (class, nargs, args)
 830      Lisp_Object class, *args;
 831      int nargs;
 832 {
 833   jclass clazz;
 834   jobjectArray constructors;
 835   jobject constructor, object;
 836   jvalue *params;
 837   jmethodID method_id;
 838   int i, nconstructors;
 839   const Extbyte *param_sig;
 840   Lisp_JavaObject *javaobject;
 841
 842   clazz = XJAVACLASS (class)->class;
 843   constructors = jni_class_get_constructors (java_env, clazz);
 844   nconstructors = (*java_env)->GetArrayLength (java_env, constructors);
 845   params = alloca (sizeof (jvalue) * nargs);
 846
 847   constructor = java_find_method (java_env, constructors, NULL,
 848                                   nargs, args, params, NULL);
 849
 850   if (!constructor)
 851     error ("No such constructor: %s\n",
 852            XSTRING_DATA (XJAVACLASS (class)->name));
 853
 854   method_id = (*java_env)->FromReflectedMethod (java_env, constructor);
 855   object = (*java_env)->NewObjectA (java_env, clazz, method_id, params);
 856
 857   if (!object)
 858     return Qnil;
 859
 860   javaobject = allocate_javaobject ();
 861   javaobject->object = object;
 862   javaobject->signature = XJAVACLASS (class)->name;
 863
 864   return make_javaobject (javaobject);
 865 }
 866
 867 DEFUN ("java-make-object", Fjava_make_object, 1, MANY, 0, /*
 868 Call static method.
 869 */
 870        (int nargs, Lisp_Object *args))
 871 {
 872   Lisp_Object class = args[0];
 873
 874   CHECK_JAVACLASS (class);
 875   CHECK_LIVE_JAVAVM ();
 876
 877   return java_make_object (class, nargs - 1, args + 1);
 878 }
 879
 880 static int
 881 add_java_class_to_list_mapper (Lisp_Object key, Lisp_Object value,
 882                                void *java_class_list_closure)
 883 {
 884   /* This function can GC */
 885   struct java_class_list_closure *cscl =
 886     (struct java_class_list_closure *) java_class_list_closure;
 887   Lisp_Object *java_class_list = cscl->java_class_list;
 888
 889   *java_class_list = Fcons (value, *java_class_list);
 890   return 0;
 891 }
 892
 893 DEFUN ("java-class-list", Fjava_class_list, 0, 0, 0, /*
 894 Return a list of all loaded classes.
 895 */
 896        ())
 897 {
 898   Lisp_Object java_class_list = Qnil;
 899   struct gcpro gcpro1;
 900   struct java_class_list_closure java_class_list_closure;
 901
 902   GCPRO1 (java_class_list);
 903   java_class_list_closure.java_class_list = &java_class_list;
 904   elisp_maphash (add_java_class_to_list_mapper, Vjava_class_hash_table,
 905                  &java_class_list_closure);
 906   UNGCPRO;
 907
 908   return java_class_list;
 909 }
 910
 911 DEFUN ("java-class-name", Fjava_class_name, 1, 1, 0, /*
 912 Return the name of the given class.
 913 */
 914        (class))
 915 {
 916   CHECK_JAVACLASS (class);
 917   return XJAVACLASS (class)->name;
 918 }
 919
 920 static int
 921 jni_lookup_primitive_call_table (signature)
 922      const char *signature;
 923 {
 924   const char *p = strchr (jni_primitive_signature_table, signature[0]);
 925   if (!p)
 926     return -1;
 927   return (p - jni_primitive_signature_table);
 928 }
 929
 930 inline static jvalue
 931 jni_primitive_call_method (env, return_sig, object, method, params)
 932      JNIEnv *env;
 933      const Extbyte *return_sig;
 934      jobject object;
 935      jmethodID method;
 936      jvalue *params;
 937 {
 938   int index = jni_lookup_primitive_call_table (return_sig);
 939   return (jvalue)(*jni_primitive_call_table[index].call_method)
 940     (env, object, method, params);
 941 }
 942
 943 inline static jvalue
 944 jni_primitive_call_static_method (env, return_sig, class, method, params)
 945      JNIEnv *env;
 946      const Extbyte *return_sig;
 947      jclass class;
 948      jmethodID method;
 949      jvalue *params;
 950 {
 951   int index = jni_lookup_primitive_call_table (return_sig);
 952   return (jvalue)(*jni_primitive_call_table[index].call_static_method)
 953     (env, class, method, params);
 954 }
 955
 956 inline static jarray
 957 jni_primitive_new_array (env, element_sig, len)
 958      JNIEnv *env;
 959      const Extbyte *element_sig;
 960      jsize len;
 961 {
 962   int index = jni_lookup_primitive_call_table (element_sig);
 963   return (*jni_primitive_call_table[index].new_array)
 964     (env, len);
 965 }
 966
 967 inline static void
 968 jni_primitive_set_array_element (env, element_sig, array, n, element)
 969      JNIEnv *env;
 970      const Extbyte *element_sig;
 971      jarray array;
 972      jsize n;
 973      jvalue element;
 974 {
 975   int index = jni_lookup_primitive_call_table (element_sig);
 976   jni_primitive_call_table[index].set_array_element
 977     (env, array, n, element);
 978 }
 979
 980 inline static jvalue
 981 jni_primitive_get_array_element (env, element_sig, array, n)
 982      JNIEnv *env;
 983      const Extbyte *element_sig;
 984      jarray array;
 985      jsize n;
 986 {
 987   int index = jni_lookup_primitive_call_table (element_sig);
 988   return (jvalue)(*jni_primitive_call_table[index].get_array_element)
 989     (env, array, n);
 990 }
 991
 992 #define DEFINE_JNI_ARRAY_SET(atype,jtype,type)                          \
 993 static void jni_set_##jtype##_array_element (JNIEnv *, jarray,          \
 994                                              jsize, jvalue);            \
 995 static void jni_set_##jtype##_array_element (JNIEnv *env, jarray array, \
 996                                              jsize n, jvalue element) { \
 997   jtype *elements;                                                      \
 998   jboolean is_copy;                                                     \
 999   elements = (*env)->Get##type##ArrayElements (env, (atype)array,       \
1000                                                &is_copy);               \
1001   elements[n] = *(jtype*)&element;                                      \
1002   if (is_copy == JNI_TRUE)                                              \
1003     (*env)->Release##type##ArrayElements                                \
1004       (env, (atype)array, elements, 0);                                 \
1005 }
1006
1007 DEFINE_JNI_ARRAY_SET(jbooleanArray, jboolean, Boolean)
1008 DEFINE_JNI_ARRAY_SET(jbyteArray, jbyte, Byte)
1009 DEFINE_JNI_ARRAY_SET(jcharArray, jchar, Char)
1010 DEFINE_JNI_ARRAY_SET(jshortArray, jshort, Short)
1011 DEFINE_JNI_ARRAY_SET(jintArray, jint, Int)
1012 DEFINE_JNI_ARRAY_SET(jlongArray, jlong, Long)
1013 DEFINE_JNI_ARRAY_SET(jfloatArray, jfloat, Float)
1014 DEFINE_JNI_ARRAY_SET(jdoubleArray, jdouble, Double)
1015
1016 #define DEFINE_JNI_ARRAY_GET(atype,jtype,type)                          \
1017 static jlong jni_get_##jtype##_array_element (JNIEnv *, jarray, jsize); \
1018 static jlong jni_get_##jtype##_array_element (JNIEnv *env,              \
1019                                               jarray array, jsize n) {  \
1020   jtype *elements;                                                      \
1021   jboolean is_copy;                                                     \
1022   elements = (*env)->Get##type##ArrayElements (env, (atype)array,       \
1023                                                &is_copy);               \
1024   return (jlong)elements[n];                                            \
1025 }
1026
1027 DEFINE_JNI_ARRAY_GET(jbooleanArray, jboolean, Boolean)
1028 DEFINE_JNI_ARRAY_GET(jbyteArray, jbyte, Byte)
1029 DEFINE_JNI_ARRAY_GET(jcharArray, jchar, Char)
1030 DEFINE_JNI_ARRAY_GET(jshortArray, jshort, Short)
1031 DEFINE_JNI_ARRAY_GET(jintArray, jint, Int)
1032 DEFINE_JNI_ARRAY_GET(jlongArray, jlong, Long)
1033 DEFINE_JNI_ARRAY_GET(jfloatArray, jfloat, Float)
1034 DEFINE_JNI_ARRAY_GET(jdoubleArray, jdouble, Double)
1035
1036 static void
1037 jni_initialize_primitive_call_table (env)
1038      JNIEnv *env;
1039 {
1040   jni_primitive_call_table[0].call_method =
1041     (jni_method_caller)(*env)->CallBooleanMethodA;
1042   jni_primitive_call_table[0].call_static_method =
1043     (jni_static_method_caller)(*env)->CallStaticBooleanMethodA;
1044   jni_primitive_call_table[0].call_nonvirtual_method =
1045     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualBooleanMethodA;
1046   jni_primitive_call_table[0].new_array =
1047     (jni_array_allocater)(*env)->NewBooleanArray;
1048   jni_primitive_call_table[0].set_array_element =
1049     jni_set_jboolean_array_element;
1050   jni_primitive_call_table[0].get_array_element =
1051     jni_get_jboolean_array_element;
1052
1053   jni_primitive_call_table[1].call_method =
1054     (jni_method_caller)(*env)->CallByteMethodA;
1055   jni_primitive_call_table[1].call_static_method =
1056     (jni_static_method_caller)(*env)->CallStaticByteMethodA;
1057   jni_primitive_call_table[1].call_nonvirtual_method =
1058     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualByteMethodA;
1059   jni_primitive_call_table[1].new_array =
1060     (jni_array_allocater)(*env)->NewByteArray;
1061   jni_primitive_call_table[1].set_array_element =
1062     jni_set_jbyte_array_element;
1063   jni_primitive_call_table[1].get_array_element =
1064     jni_get_jbyte_array_element;
1065
1066   jni_primitive_call_table[2].call_method =
1067     (jni_method_caller)(*env)->CallCharMethodA;
1068   jni_primitive_call_table[2].call_static_method =
1069     (jni_static_method_caller)(*env)->CallStaticCharMethodA;
1070   jni_primitive_call_table[2].call_nonvirtual_method =
1071     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualCharMethodA;
1072   jni_primitive_call_table[2].new_array =
1073     (jni_array_allocater)(*env)->NewCharArray;
1074   jni_primitive_call_table[2].set_array_element =
1075     jni_set_jchar_array_element;
1076   jni_primitive_call_table[2].get_array_element =
1077     jni_get_jchar_array_element;
1078
1079   jni_primitive_call_table[3].call_method =
1080     (jni_method_caller)(*env)->CallShortMethodA;
1081   jni_primitive_call_table[3].call_static_method =
1082     (jni_static_method_caller)(*env)->CallStaticShortMethodA;
1083   jni_primitive_call_table[3].call_nonvirtual_method =
1084     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualShortMethodA;
1085   jni_primitive_call_table[3].new_array =
1086     (jni_array_allocater)(*env)->NewShortArray;
1087   jni_primitive_call_table[3].set_array_element =
1088     jni_set_jshort_array_element;
1089   jni_primitive_call_table[3].get_array_element =
1090     jni_get_jshort_array_element;
1091
1092   jni_primitive_call_table[4].call_method =
1093     (jni_method_caller)(*env)->CallIntMethodA;
1094   jni_primitive_call_table[4].call_static_method =
1095     (jni_static_method_caller)(*env)->CallStaticIntMethodA;
1096   jni_primitive_call_table[4].call_nonvirtual_method =
1097     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualIntMethodA;
1098   jni_primitive_call_table[4].new_array =
1099     (jni_array_allocater)(*env)->NewIntArray;
1100   jni_primitive_call_table[4].set_array_element =
1101     jni_set_jint_array_element;
1102   jni_primitive_call_table[4].get_array_element =
1103     jni_get_jint_array_element;
1104
1105   jni_primitive_call_table[5].call_method =
1106     (jni_method_caller)(*env)->CallLongMethodA;
1107   jni_primitive_call_table[5].call_static_method =
1108     (jni_static_method_caller)(*env)->CallStaticLongMethodA;
1109   jni_primitive_call_table[5].call_nonvirtual_method =
1110     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualLongMethodA;
1111   jni_primitive_call_table[5].new_array =
1112     (jni_array_allocater)(*env)->NewLongArray;
1113   jni_primitive_call_table[5].set_array_element =
1114     jni_set_jlong_array_element;
1115   jni_primitive_call_table[5].get_array_element =
1116     jni_get_jlong_array_element;
1117
1118   jni_primitive_call_table[6].call_method =
1119     (jni_method_caller)(*env)->CallFloatMethodA;
1120   jni_primitive_call_table[6].call_static_method =
1121     (jni_static_method_caller)(*env)->CallStaticFloatMethodA;
1122   jni_primitive_call_table[6].call_nonvirtual_method =
1123     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualFloatMethodA;
1124   jni_primitive_call_table[6].new_array =
1125     (jni_array_allocater)(*env)->NewFloatArray;
1126   jni_primitive_call_table[6].set_array_element =
1127     jni_set_jfloat_array_element;
1128   jni_primitive_call_table[6].get_array_element =
1129     jni_get_jfloat_array_element;
1130
1131   jni_primitive_call_table[7].call_method =
1132     (jni_method_caller)(*env)->CallDoubleMethodA;
1133   jni_primitive_call_table[7].call_static_method =
1134     (jni_static_method_caller)(*env)->CallStaticDoubleMethodA;
1135   jni_primitive_call_table[7].call_nonvirtual_method =
1136     (jni_nonvirtual_method_caller)(*env)->CallNonvirtualDoubleMethodA;
1137   jni_primitive_call_table[7].new_array =
1138     (jni_array_allocater)(*env)->NewDoubleArray;
1139   jni_primitive_call_table[7].set_array_element =
1140     jni_set_jdouble_array_element;
1141   jni_primitive_call_table[7].get_array_element =
1142     jni_get_jdouble_array_element;
1143 }
1144
1145 static jobjectArray
1146 jni_class_get_methods (env, class)
1147      JNIEnv *env;
1148      jclass class;
1149 {
1150   jclass clazz = (*env)->GetObjectClass (env, class);
1151   jmethodID method = (*env)->GetMethodID (env, clazz, "getMethods",
1152                                        "()[Ljava/lang/reflect/Method;");
1153   return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL);
1154 }
1155
1156 static jobjectArray
1157 jni_class_get_constructors (env, class)
1158      JNIEnv *env;
1159      jclass class;
1160 {
1161   jclass clazz = (*env)->GetObjectClass (env, class);
1162   jmethodID method = (*env)->GetMethodID (env, clazz, "getConstructors",
1163                                        "()[Ljava/lang/reflect/Constructor;");
1164   return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL);
1165 }
1166
1167 static jstring
1168 jni_class_get_name (env, class)
1169      JNIEnv *env;
1170      jclass class;
1171 {
1172   jclass clazz = (*env)->GetObjectClass (env, class);
1173   jmethodID method = (*env)->GetMethodID (env, clazz, "getName",
1174                                        "()Ljava/lang/String;");
1175   return (jstring) (*env)->CallObjectMethod (env, class, method, NULL);
1176 }
1177
1178 static jboolean
1179 jni_class_is_primitive (env, class)
1180      JNIEnv *env;
1181      jclass class;
1182 {
1183   jclass clazz = (*env)->GetObjectClass (env, class);
1184   jmethodID method = (*env)->GetMethodID (env, clazz, "isPrimitive",
1185                                           "()Z");
1186   return (*env)->CallBooleanMethod (env, class, method, NULL);
1187 }
1188
1189 static jobjectArray
1190 jni_method_get_parameter_types (env, method)
1191      JNIEnv *env;
1192      jobject method;
1193 {
1194   jclass class = (*env)->GetObjectClass (env, method);
1195   jmethodID get_parameter_types =
1196     (*env)->GetMethodID (env, class, "getParameterTypes",
1197                          "()[Ljava/lang/Class;");
1198   return (jobjectArray) (*env)->CallObjectMethod
1199     (env, method, get_parameter_types, NULL);
1200 }
1201
1202 static jstring
1203 jni_method_get_name (env, method)
1204      JNIEnv *env;
1205      jobject method;
1206 {
1207   jclass class = (*env)->GetObjectClass (env, method);
1208   jmethodID get_name =
1209     (*env)->GetMethodID (env, class, "getName", "()Ljava/lang/String;");
1210   return (jstring) (*env)->CallObjectMethod (env, method, get_name, NULL);
1211 }
1212
1213 static jint
1214 jni_method_get_modifiers (env, method)
1215      JNIEnv *env;
1216      jobject method;
1217 {
1218   jclass class = (*env)->GetObjectClass (env, method);
1219   jmethodID get_modifiers =
1220     (*env)->GetMethodID (env, class, "getModifiers", "()I");
1221   return (*env)->CallIntMethod (env, method, get_modifiers, NULL);
1222 }
1223
1224 static jclass
1225 jni_method_get_return_type (env, method)
1226      JNIEnv *env;
1227      jobject method;
1228 {
1229   jclass class = (*env)->GetObjectClass (env, method);
1230   jmethodID get_return_type =
1231     (*env)->GetMethodID (env, class, "getReturnType", "()Ljava/lang/Class;");
1232   return (jclass) (*env)->CallObjectMethod
1233     (env, method, get_return_type, NULL);
1234 }
1235
1236 static jboolean
1237 jni_modifier_is_static (env, modifiers)
1238      JNIEnv *env;
1239      jint modifiers;
1240 {
1241   static jclass class = NULL;
1242   jmethodID is_static;
1243
1244   if (!class)
1245     class = (*env)->FindClass (env, "java/lang/reflect/Modifier");
1246   is_static = (*env)->GetStaticMethodID (env, class, "isStatic", "(I)Z");
1247   return (*env)->CallStaticBooleanMethod (env, class, is_static, modifiers);
1248 }
1249
1250 static jboolean
1251 jni_modifier_is_non_static (env, modifiers)
1252      JNIEnv *env;
1253      jint modifiers;
1254 {
1255   if (jni_modifier_is_static (env, modifiers) == JNI_TRUE)
1256     return JNI_FALSE;
1257   return JNI_TRUE;
1258 }
1259
1260 static void
1261 jni_check_exception (env)
1262      JNIEnv *env;
1263 {
1264   jthrowable throwable;
1265
1266   throwable = (*env)->ExceptionOccurred (env);
1267   if (!throwable)
1268     return;
1269
1270   (*env)->ExceptionClear (env);
1271   error ("Exception occurred.");
1272 }
1273
1274 static jvalue
1275 jni_call_static_method (env, return_sig, class, method, params)
1276      JNIEnv *env;
1277      const Extbyte *return_sig;
1278      jclass class;
1279      jmethodID method;
1280      jvalue *params;
1281 {
1282   jthrowable throwable;
1283   jvalue value;
1284
1285   switch (return_sig[0])
1286     {
1287     case 'V':
1288       (*env)->CallStaticVoidMethodA (env, class, method, params);
1289       value.l = NULL;
1290     case 'L': case '[':
1291       value = (jvalue)(*env)->CallStaticObjectMethodA
1292         (env, class, method, params);
1293       break;
1294     default:
1295       value = jni_primitive_call_static_method (env, return_sig, class,
1296                                                 method, params);
1297       break;
1298     }
1299
1300   return value;
1301 }
1302
1303 static jvalue
1304 jni_call_virtual_method (env, return_sig, object, method, params)
1305      JNIEnv *env;
1306      const Extbyte *return_sig;
1307      jobject object;
1308      jmethodID method;
1309      jvalue *params;
1310 {
1311   jthrowable throwable;
1312   jvalue value;
1313
1314   switch (return_sig[0])
1315     {
1316     case 'V':
1317       (*env)->CallVoidMethodA (env, object, method, params);
1318       value.l = NULL;
1319     case 'L': case '[':
1320       value = (jvalue)(*env)->CallObjectMethodA (env, object, method, params);
1321       break;
1322     default:
1323       value = jni_primitive_call_method (env, return_sig, object, method,
1324                                          params);
1325       break;
1326     }
1327
1328   return value;
1329 }
1330
1331
1332 void
1333 syms_of_java (void)
1334 {
1335   INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaclass);
1336   INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaobject);
1337   defsymbol (&Qjava, "java");
1338
1339   defsymbol (&Qjavaclassp, "javaclassp");
1340   defsymbol (&Qjavaobjectp, "javaobjectp");
1341
1342   DEFSUBR (Fjava_find_class);
1343   DEFSUBR (Fjava_call_virtual_method);
1344   DEFSUBR (Fjava_call_static_method);
1345   DEFSUBR (Fjava_make_object);
1346   DEFSUBR (Fjava_class_list);
1347   DEFSUBR (Fjava_class_name);
1348 }
1349
1350 void
1351 vars_of_java (void)
1352 {
1353   char *p;
1354
1355   Fprovide (Qjava);
1356
1357   DEFVAR_LISP ("java-coding-system", &Vjava_coding_system /*
1358 Default Java Vartual Machine coding system.
1359 */);
1360   Vjava_coding_system = Qnative;
1361
1362   DEFVAR_LISP ("java-class-path", &Vjava_class_path /*
1363 Default class path.
1364 */);
1365   p = getenv ("CLASSPATH");
1366   if (!p)
1367     Vjava_class_path = Qnil;
1368   else
1369     Vjava_class_path = build_ext_string (p, JAVA_OS_CODING);
1370
1371   initialize_javavm ();
1372
1373   staticpro (&Vjava_class_hash_table);
1374   Vjava_class_hash_table =
1375     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1376 }