pax_global_header00006660000000000000000000000064136266754650014536gustar00rootroot0000000000000052 comment=49864445db02af55bc6234ad65606577ec6b3dbc camljava-camljava04/000077500000000000000000000000001362667546500146005ustar00rootroot00000000000000camljava-camljava04/Changes000066400000000000000000000010071362667546500160710ustar00rootroot00000000000000Version 0.4, 2020-03-01 - Add NewGlobalRef registration for classes involved in callbacks (#2) - Compatibility with OCaml 4.09 and up - Export "exception Exception of obj" in jni.mli - Update Makefile.config to OpenJDK 8 for Linux/AMD64 - Migration to Github - Add Jni.set_string_auto_conv to control autoconversion of strings - Add Jni.set_debug to help debug stray exceptions - Ensure that callbacks are done from main Java thread - Fix confusion between fields of types "float" and "double" Version 0.3, 2004-07-13 camljava-camljava04/Makefile000066400000000000000000000002501362667546500162350ustar00rootroot00000000000000all: cd lib; $(MAKE) all byte: cd lib; $(MAKE) byte install: cd lib; $(MAKE) install tst: cd test; $(MAKE) clean: cd lib; $(MAKE) clean cd test; $(MAKE) clean camljava-camljava04/Makefile.config000066400000000000000000000027511362667546500175110ustar00rootroot00000000000000################### C compiler ######################## # C compiler to use CC=gcc # Flags for $(CC) CFLAGS=-O -g -Wall ################### Java compiler ##################### # Java compiler to use JAVAC=javac -g ################### JNI interface ##################### ## Defaults are set for OpenJDK 8 under Linux/AMD64. ## For other platforms, adjust as required and tell us about it. # Home location for the JDK. Only used for setting other variables below. JDKHOME=/usr/lib/jvm/java-8-openjdk-amd64 # Current architecture identification string, as intended by the JDK. # Common values for x86 architectures are "i386" or "amd64". You can find it # out by looking for the "*" patch component in the following pattern: # $(JDKHOME)/jre/lib/*/libjava.so ARCH=amd64 # Where to find the JNI include files (for compiling the OCaml-JNI C stubs) JNIINCLUDES=-I$(JDKHOME)/include -I$(JDKHOME)/include/linux # The library to link with to get the JNI JNILIBS=-ljvm # Additional link-time options to pass to $(CC) when linking with $(JNILIBS) JNILIBOPTS=-L$(JDKHOME)/jre/lib/$(ARCH)/ \ -L$(JDKHOME)/jre/lib/$(ARCH)/server \ -Wl,-rpath,$(JDKHOME)/jre/lib/$(ARCH)/ \ -Wl,-rpath,$(JDKHOME)/jre/lib/$(ARCH)/server \ -Wl,-rpath,$(JDKHOME)/jre/lib/$(ARCH)/native_threads # Additional options when compiling the OCaml-JNI C stubs. # -DJDK122_LINUX_HACK works around a nasty thread-related bug of # Sun's JDK 1.2.2 under Linux #JNISTUBSOPTIONS=-DJDK122_LINUX_HACK JNISTUBSOPTIONS= camljava-camljava04/Makefile.config.msvc000077500000000000000000000014561362667546500204640ustar00rootroot00000000000000################### C compiler ######################## # C compiler to use CC=cl /nologo # Flags for $(CC) CFLAGS=/Ox /MT /Zi ################### Java compiler ##################### # Java compiler to use JAVAC=javac -g ################### JNI interface ##################### ## Defaults are set for Sun's JDK 1.4.1 under Windows # Home location for the JDK. Only used for setting other variables below. JDKHOME=C:/j2sdk1.4.1 # Where to find the JNI include files (for compiling the OCaml-JNI C stubs) JNIINCLUDES=-I$(JDKHOME)/include -I$(JDKHOME)/include/win32 # The library to link with to get the JNI JNILIBS=$(JDKHOME)/lib/jvm.lib # Additional link-time options to pass to $(CC) when linking with $(JNILIBS) JNILIBOPTS= # Additional options when compiling the OCaml-JNI C stubs. JNISTUBSOPTIONS= camljava-camljava04/Makefile.msvc000077500000000000000000000002551362667546500172140ustar00rootroot00000000000000MK=$(MAKE) -f Makefile.msvc all: cd lib; $(MK) all install: cd lib; $(MK) install tst: cd test; $(MK) clean: cd lib; $(MK) clean cd test; $(MK) clean camljava-camljava04/README000066400000000000000000000043461362667546500154670ustar00rootroot00000000000000 CamlJava - an OCaml/Java interface ================================== DESCRIPTION: This is a very preliminary release of CamlJava, an OCaml/Java interface based on the following schema: Caml/C interface JNI (Java Native Interface) Caml <------------------> C <-----------------------------> Java Currently, CamlJava provides a low-level, weakly-typed OCaml interface very similar to the JNI. Java object references are mapped to an abstract type, and various JNI-like operations are provided to allow Java method invocation, field access, and more. A basic callback facility (allowing Java code to invoke methods on Caml objects) is also provided, although some stub Java code must be written by hand. In the future, a higher-level, strongly-typed interface will be provided, whereas Java classes are mapped directly to Caml classes. This raises fairly delicate type mapping issues, though, so don't hold your breath. REQUIREMENTS: - This release of CamlJava requires Objective Caml version 3.08 or later. - A Java implementation that supports JNI (Java Native Interface). So far, only Sun's JDK has been tested. INSTALLATION ON A UNIX PLATFORM: - Edit Makefile.config to define parameters depending on your Java installation. As distributed, the library is set up for Sun's JDK version 1.4.1 on a Linux x86 platform. - make become superuser make install - For testing: make tst INSTALLATION ON A WINDOWS PLATFORM: - Works with the MSVC port of OCaml for Windows. GNU make and Cygwin tools are required to do the installation. - Edit Makefile.config.msvc to define parameters depending on your Java installation. - make -f Makefile.msvc make -f Makefile.msvc install - For testing: make -f Makefile.msvc tst USAGE: The module is named "Jni". A good knowledge of the JNI is assumed; see Sun's JNI book or http://java.sun.com/products/jdk/1.2/docs/guide/jni/ Then, the comments in lib/jni.mli should make sense. Usage: ocamlc -I +camljava jni.cma ... or ocamlopt -I +camljava jni.cmxa ... See the programs in test/ for examples of use. LICENSE: GNU Library General Public License version 2. FEEDBACK: e-mail the author, Xavier.Leroy@inria.fr. camljava-camljava04/lib/000077500000000000000000000000001362667546500153465ustar00rootroot00000000000000camljava-camljava04/lib/.cvsignore000066400000000000000000000000071362667546500173430ustar00rootroot00000000000000jni.ml camljava-camljava04/lib/.depend000066400000000000000000000000441362667546500166040ustar00rootroot00000000000000jni.cmo: jni.cmi jni.cmx: jni.cmi camljava-camljava04/lib/Makefile000066400000000000000000000026661362667546500170200ustar00rootroot00000000000000include ../Makefile.config OCAMLC=ocamlc -g OCAMLOPT=ocamlopt OCAMLDEP=ocamldep OCAMLLIB=`ocamlc -where` CAMLJAVALIB=$(OCAMLLIB)/camljava all: jni.cma jni.cmxa camljava.jar byte: jni.cma camljava.jar install: mkdir -p $(CAMLJAVALIB) cp jni.cma jni.cmi $(wildcard jni.cmxa jni.a) libcamljni.a jni.mli camljava.jar $(CAMLJAVALIB) jni.cma: jni.cmo libcamljni.a $(OCAMLC) -linkall -a -o jni.cma -custom jni.cmo \ -ccopt "$(JNILIBOPTS)" -cclib -lcamljni -cclib "$(JNILIBS)" jni.cmxa: jni.cmx libcamljni.a $(OCAMLOPT) -linkall -a -o jni.cmxa jni.cmx \ -ccopt "$(JNILIBOPTS)" -cclib -lcamljni -cclib "$(JNILIBS)" libcamljni.a: jnistubs.o rm -f libcamljni.a ar rcs libcamljni.a jnistubs.o clean:: rm -f libcamljni.a jni.ml: jni.mlp jni.mli ../Makefile.config rm -f jni.ml sed -e 's|%PATH%|'$(CAMLJAVALIB)/camljava.jar'|' \ jni.mlp > jni.ml chmod -w jni.ml clean:: rm -f jni.ml beforedepend:: jni.ml camljava.jar: javaclasses jar cf camljava.jar fr/inria/caml/camljava/*.class clean:: rm -f camljava.jar javaclasses: $(JAVAC) fr/inria/caml/camljava/*.java clean:: rm -f fr/inria/caml/camljava/*.class clean:: rm -f *.cm? *.[oa] *.cmxa .SUFFIXES: .ml .mli .cmo .cmi .cmx .c.o: $(CC) -c $(CFLAGS) $(JNIINCLUDES) -I$(OCAMLLIB) $*.c .ml.cmo: $(OCAMLC) -c $*.ml .ml.cmx: $(OCAMLOPT) -c $*.ml .mli.cmi: $(OCAMLC) -c $*.mli depend: beforedepend $(OCAMLDEP) *.mli *.ml > .depend include .depend camljava-camljava04/lib/Makefile.msvc000077500000000000000000000025731362667546500177670ustar00rootroot00000000000000include ../Makefile.config.msvc OCAMLC=ocamlc -g OCAMLOPT=ocamlopt OCAMLDEP=ocamldep OCAMLLIB=`ocamlc -where` CAMLJAVALIB=$(OCAMLLIB)/camljava all: jni.cma jni.cmxa javaclasses install: mkdir -p $(CAMLJAVALIB) cp jni.cma jni.cmi jni.cmxa jni.lib libcamljni.lib jni.mli $(CAMLJAVALIB) jar cf $(CAMLJAVALIB)/camljava.jar fr/inria/caml/camljava/*.class jni.cma: jni.cmo libcamljni.lib $(OCAMLC) -linkall -a -o jni.cma -custom jni.cmo \ -ccopt "$(JNILIBOPTS)" -cclib -lcamljni -cclib "$(JNILIBS)" jni.cmxa: jni.cmx libcamljni.lib $(OCAMLOPT) -linkall -a -o jni.cmxa jni.cmx \ -ccopt "$(JNILIBOPTS)" -cclib -lcamljni -cclib "$(JNILIBS)" libcamljni.lib: jnistubs.obj lib /nologo /debugtype:CV /out:libcamljni.lib jnistubs.obj clean:: rm -f libcamljni.lib jni.ml: jni.mlp jni.mli ../Makefile.config rm -f jni.ml sed -e 's|%PATH%|'$(CAMLJAVALIB)/camljava.jar'|' \ jni.mlp > jni.ml chmod -w jni.ml clean:: rm -f jni.ml beforedepend:: jni.ml javaclasses: $(JAVAC) fr/inria/caml/camljava/*.java clean:: rm -f fr/inria/caml/camljava/*.class clean:: rm -f *.cm? *.obj *.lib .SUFFIXES: .c .obj .ml .mli .cmo .cmi .cmx .c.obj: $(CC) -c $(CFLAGS) $(JNIINCLUDES) -I$(OCAMLLIB) $*.c .ml.cmo: $(OCAMLC) -c $*.ml .ml.cmx: $(OCAMLOPT) -c $*.ml .mli.cmi: $(OCAMLC) -c $*.mli depend: beforedepend $(OCAMLDEP) *.mli *.ml > .depend include .depend camljava-camljava04/lib/fr/000077500000000000000000000000001362667546500157555ustar00rootroot00000000000000camljava-camljava04/lib/fr/inria/000077500000000000000000000000001362667546500170575ustar00rootroot00000000000000camljava-camljava04/lib/fr/inria/caml/000077500000000000000000000000001362667546500177735ustar00rootroot00000000000000camljava-camljava04/lib/fr/inria/caml/camljava/000077500000000000000000000000001362667546500215515ustar00rootroot00000000000000camljava-camljava04/lib/fr/inria/caml/camljava/Boolean.java000066400000000000000000000002101362667546500237640ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Boolean { public boolean contents; public Boolean(boolean c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Byte.java000066400000000000000000000001731362667546500233200ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Byte { public byte contents; public Byte(byte c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Callback.java000066400000000000000000000047131362667546500241150ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Callback { public Callback(long obj) { objref = obj; } protected void finalize() { freeWrapper(objref); } public native static long getCamlMethodID(String method_name); public void callVoid(long methid, Object args[]) { callbackVoid(objref, methid, args); } public boolean callBoolean(long methid, Object args[]) { return callbackBoolean(objref, methid, args); } public byte callByte(long methid, Object args[]) { return callbackByte(objref, methid, args); } public char callChar(long methid, Object args[]) { return callbackChar(objref, methid, args); } public short callShort(long methid, Object args[]) { return callbackShort(objref, methid, args); } public int callCamlint(long methid, Object args[]) { return callbackCamlint(objref, methid, args); } public int callInt(long methid, Object args[]) { return callbackInt(objref, methid, args); } public long callLong(long methid, Object args[]) { return callbackLong(objref, methid, args); } public float callFloat(long methid, Object args[]) { return callbackFloat(objref, methid, args); } public double callDouble(long methid, Object args[]) { return callbackDouble(objref, methid, args); } public Object callObject(long methid, Object args[]) { return callbackObject(objref, methid, args); } private long objref; private native static void callbackVoid(long obj, long methid, Object args[]); private native static boolean callbackBoolean(long obj, long methid, Object args[]); private native static byte callbackByte(long obj, long methid, Object args[]); private native static char callbackChar(long obj, long methid, Object args[]); private native static short callbackShort(long obj, long methid, Object args[]); private native static int callbackCamlint(long obj, long methid, Object args[]); private native static int callbackInt(long obj, long methid, Object args[]); private native static long callbackLong(long obj, long methid, Object args[]); private native static float callbackFloat(long obj, long methid, Object args[]); private native static double callbackDouble(long obj, long methid, Object args[]); private native static Object callbackObject(long obj, long methid, Object args[]); private native static void freeWrapper(long obj); } camljava-camljava04/lib/fr/inria/caml/camljava/Camlint.java000066400000000000000000000001771362667546500240100ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Camlint { public int contents; public Camlint(int c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Char.java000066400000000000000000000001731362667546500232720ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Char { public char contents; public Char(char c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Double.java000066400000000000000000000002031362667546500236210ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Double { public double contents; public Double(double c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Exception.java000066400000000000000000000002621362667546500243520ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Exception extends java.lang.Exception { public Exception () { super(); } public Exception (String msg) { super(msg); } } camljava-camljava04/lib/fr/inria/caml/camljava/Float.java000066400000000000000000000001771362667546500234660ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Float { public float contents; public Float(float c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Int.java000066400000000000000000000001671362667546500231520ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Int { public int contents; public Int(int c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Long.java000066400000000000000000000001731362667546500233140ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Long { public long contents; public Long(long c) { contents = c; } } camljava-camljava04/lib/fr/inria/caml/camljava/Readclass.java000066400000000000000000000121001362667546500243070ustar00rootroot00000000000000package fr.inria.caml.camljava; import java.util.Vector; import java.io.*; import java.util.jar.*; import java.util.HashSet; public class Readclass { public static void main(String argv[]) { Vector path = new Vector(10); String cmdline; addPath(path, System.getProperty("sun.boot.class.path")); addPath(path, System.getProperty("java.class.path")); while (true) { try { cmdline = readLine(System.in); if (cmdline == null) return; if (cmdline.length() < 1) continue; switch (cmdline.charAt(0)) { case '?': System.out.write(1); break; case 'Q': return; case 'R': readClass(path, cmdline.substring(1)); System.err.println("Done R"); break; case 'P': readPackage(path, cmdline.substring(1)); System.err.println("Done P"); break; } System.out.flush(); } catch (IOException e) { /*nothing*/; } } } private static void addPath(Vector pathvect, String path) { if (path == null) return; for (int i = 0; i < path.length(); /*nothing*/) { int j = path.indexOf(java.io.File.pathSeparatorChar, i); if (j == -1) { addElementToPath(pathvect, path.substring(i)); break; } else { addElementToPath(pathvect, path.substring(i, j)); i = j + 1; } } } private static void addElementToPath(Vector pathvect, String element) { if (! pathvect.contains(element)) pathvect.add(element); } private static void readClass(Vector path, String classname) { for (int i = path.size() - 1; i >= 0; i--) { try { File pathcomp = new File((String) (path.elementAt(i))); if (!pathcomp.exists()) continue; if (pathcomp.isDirectory()) { File f = new File(pathcomp, classname.replace('/', File.separatorChar) + ".class"); if (! f.exists()) continue; byte [] data = readFile(f); System.out.write(1); System.out.write(data); return; } else if (pathcomp.isFile()) { JarFile jf = new JarFile(pathcomp); JarEntry je = jf.getJarEntry(classname + ".class"); if (je == null) { jf.close(); continue; } byte [] data = readStream(jf.getInputStream(je), je.getSize()); jf.close(); System.out.write(1); System.out.write(data); return; } } catch (IOException e) { /*nothing*/; } } System.out.write(0); } private static void readPackage(Vector path, String packagename) { HashSet classes = new HashSet(); for (int i = path.size() - 1; i >= 0; i--) { try { File pathcomp = new File((String) (path.elementAt(i))); if (!pathcomp.exists()) continue; if (pathcomp.isDirectory()) { File d = new File(pathcomp, packagename.replace('/', File.separatorChar)); String [] contents = d.list(); if (contents == null) continue; for (int j = 0; j < contents.length; j++) { String f = contents[i]; if (! f.endsWith(".class")) continue; if (! classes.add(packagename + '/' + f)) continue; byte [] data = readFile(new File(d, f)); System.out.write(1); System.out.write(data); } } else if (pathcomp.isFile()) { JarInputStream js = new JarInputStream(new FileInputStream(pathcomp)); JarEntry je; while ((je = js.getNextJarEntry()) != null) { String entryname = je.getName(); // System.err.println(entryname); int lastslash = entryname.lastIndexOf('/'); if (lastslash == -1) continue; if (! packagename.equals(entryname.substring(0, lastslash))) continue; if (! entryname.endsWith(".class")) continue; if (! classes.add(entryname)) continue; byte [] data = readStream(js, je.getSize()); System.out.write(1); System.out.write(data); } js.close(); } } catch (IOException e) { /*nothing*/; } } System.out.write(0); } private static byte[] readFile(File f) throws IOException { FileInputStream s = new FileInputStream(f); try { return readStream(s, f.length()); } finally { s.close(); } } private static byte[] readStream(InputStream s, long length) throws IOException { int len = (int) length; byte[] buffer = new byte[len]; for (int i = 0; i < len; /*nothing*/) { int nread = s.read(buffer, i, len - i); i += nread; } return buffer; } private static String readLine(InputStream s) throws IOException { StringBuffer sb = new StringBuffer(); while (true) { int i = s.read(); if (i == -1) return null; System.err.write(i); System.err.flush(); if (i == 10) return sb.toString(); sb.append((char) i); } } } camljava-camljava04/lib/fr/inria/caml/camljava/Short.java000066400000000000000000000001771362667546500235200ustar00rootroot00000000000000package fr.inria.caml.camljava; public class Short { public short contents; public Short(short c) { contents = c; } } camljava-camljava04/lib/jni.mli000066400000000000000000000370751362667546500166450ustar00rootroot00000000000000(***********************************************************************) (* *) (* OCamlJava: Objective Caml / Java interface *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License. *) (* *) (***********************************************************************) (* $Id: jni.mli,v 1.2 2005-10-21 08:19:11 xleroy Exp $ *) (* Low-level Java interface (JNI level) *) external set_debug: bool -> unit = "camljava_set_debug" external set_string_auto_conv: bool -> unit = "camljava_set_strconv" (* Object operations *) type obj (* The type of Java object references *) val null: obj (* The [null] object reference *) exception Null_pointer (* Exception raised by the operations below when they encounter a null object reference in arguments that must be non-null. *) exception Exception of obj (* Exception raised by the method invocation functions below when the Java method terminates on an unhandled exception. *) external is_null: obj -> bool = "camljava_IsNull" (* Determine if the given object reference is [null] *) external is_same_object: obj -> obj -> bool = "camljava_IsSameObject" (* Determine if two object references are the same (as per [==] in Java). *) (* String operations. Java strings are represented in Caml by their UTF8 encoding. *) external string_to_java: string -> obj = "camljava_MakeJavaString" external string_from_java: obj -> string = "camljava_ExtractJavaString" (* Conversion between Caml strings and Java strings. *) val null_string: string (* A distinguished Caml string that represents the [null] Java string reference. *) val is_null_string: string -> bool (* Determine whether its argument is the distinguished Caml string representing the [null] Java string reference. *) (* Class operations *) type clazz (* The type of class identifiers *) external find_class: string -> clazz = "camljava_FindClass" (* Find a class given its fully qualified name, e.g. "java/lang/Object". Note the use of slashes [/] to separate components of the name. *) external get_superclass: clazz -> clazz = "camljava_GetSuperclass" (* Return the super-class of the given class. *) external is_assignable_from: clazz -> clazz -> bool = "camljava_IsAssignableFrom" (* Assignment compatibility predicate. *) external get_object_class: obj -> clazz = "camljava_GetObjectClass" (* Return the class of an object. *) external is_instance_of: obj -> clazz -> bool = "camljava_IsInstanceOf" (* Determine if the given object reference is an instance of the given class *) external alloc_object: clazz -> obj = "camljava_AllocObject" (* Allocate a new instance of the given class *) (* Field and method identifiers *) type fieldID (* The type of field identifiers *) type methodID (* The type of method identifiers *) external get_fieldID: clazz -> string -> string -> fieldID = "camljava_GetFieldID" (* [get_fieldID cls name descr] returns the identifier of the instance field named [name] with descriptor (type) [descr] in class [cls]. *) external get_static_fieldID: clazz -> string -> string -> fieldID = "camljava_GetStaticFieldID" (* Same, for a static field. *) external get_methodID: clazz -> string -> string -> methodID = "camljava_GetMethodID" (* [get_methodID cls name descr] returns the identifier of the virtual method named [name] with descriptor (type) [descr] in class [cls]. *) external get_static_methodID: clazz -> string -> string -> methodID = "camljava_GetStaticMethodID" (* Same, for a static method. *) (* Field access *) external get_object_field: obj -> fieldID -> obj = "camljava_GetObjectField" external get_boolean_field: obj -> fieldID -> bool = "camljava_GetBooleanField" external get_byte_field: obj -> fieldID -> int = "camljava_GetByteField" external get_char_field: obj -> fieldID -> int = "camljava_GetCharField" external get_short_field: obj -> fieldID -> int = "camljava_GetShortField" external get_int_field: obj -> fieldID -> int32 = "camljava_GetIntField" external get_camlint_field: obj -> fieldID -> int = "camljava_GetCamlintField" external get_long_field: obj -> fieldID -> int64 = "camljava_GetLongField" external get_float_field: obj -> fieldID -> float = "camljava_GetFloatField" external get_double_field: obj -> fieldID -> float = "camljava_GetDoubleField" external set_object_field: obj -> fieldID -> obj -> unit = "camljava_SetObjectField" external set_boolean_field: obj -> fieldID -> bool -> unit = "camljava_SetBooleanField" external set_byte_field: obj -> fieldID -> int -> unit = "camljava_SetByteField" external set_char_field: obj -> fieldID -> int -> unit = "camljava_SetCharField" external set_short_field: obj -> fieldID -> int -> unit = "camljava_SetShortField" external set_int_field: obj -> fieldID -> int32 -> unit = "camljava_SetIntField" external set_camlint_field: obj -> fieldID -> int -> unit = "camljava_SetCamlintField" external set_long_field: obj -> fieldID -> int64 -> unit = "camljava_SetLongField" external set_float_field: obj -> fieldID -> float -> unit = "camljava_SetFloatField" external set_double_field: obj -> fieldID -> float -> unit = "camljava_SetDoubleField" external get_static_object_field: clazz -> fieldID -> obj = "camljava_GetStaticObjectField" external get_static_boolean_field: clazz -> fieldID -> bool = "camljava_GetStaticBooleanField" external get_static_byte_field: clazz -> fieldID -> int = "camljava_GetStaticByteField" external get_static_char_field: clazz -> fieldID -> int = "camljava_GetStaticCharField" external get_static_short_field: clazz -> fieldID -> int = "camljava_GetStaticShortField" external get_static_int_field: clazz -> fieldID -> int32 = "camljava_GetStaticIntField" external get_static_camlint_field: clazz -> fieldID -> int = "camljava_GetStaticCamlintField" external get_static_long_field: clazz -> fieldID -> int64 = "camljava_GetStaticLongField" external get_static_float_field: clazz -> fieldID -> float = "camljava_GetStaticFloatField" external get_static_double_field: clazz -> fieldID -> float = "camljava_GetStaticDoubleField" external set_static_obj_field: clazz -> fieldID -> obj -> unit = "camljava_SetStaticObjectField" external set_static_boolean_field: clazz -> fieldID -> bool -> unit = "camljava_SetStaticBooleanField" external set_static_byte_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticByteField" external set_static_char_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticCharField" external set_static_short_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticShortField" external set_static_int_field: clazz -> fieldID -> int32 -> unit = "camljava_SetStaticIntField" external set_static_camlint_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticCamlintField" external set_static_long_field: clazz -> fieldID -> int64 -> unit = "camljava_SetStaticLongField" external set_static_float_field: clazz -> fieldID -> float -> unit = "camljava_SetStaticFloatField" external set_static_double_field: clazz -> fieldID -> float -> unit = "camljava_SetStaticDoubleField" (* Method invocation *) type argument = Boolean of bool | Byte of int | Char of int | Short of int | Camlint of int | Int of int32 | Long of int64 | Float of float | Double of float | Obj of obj (* Datatype representing one argument of a Java method. *) external call_object_method: obj -> methodID -> argument array -> obj = "camljava_CallObjectMethod" external call_boolean_method: obj -> methodID -> argument array -> bool = "camljava_CallBooleanMethod" external call_byte_method: obj -> methodID -> argument array -> int = "camljava_CallByteMethod" external call_char_method: obj -> methodID -> argument array -> int = "camljava_CallCharMethod" external call_short_method: obj -> methodID -> argument array -> int = "camljava_CallShortMethod" external call_int_method: obj -> methodID -> argument array -> int32 = "camljava_CallIntMethod" external call_camlint_method: obj -> methodID -> argument array -> int = "camljava_CallCamlintMethod" external call_long_method: obj -> methodID -> argument array -> int64 = "camljava_CallLongMethod" external call_float_method: obj -> methodID -> argument array -> float = "camljava_CallFloatMethod" external call_double_method: obj -> methodID -> argument array -> float = "camljava_CallDoubleMethod" external call_void_method: obj -> methodID -> argument array -> unit = "camljava_CallVoidMethod" external call_static_object_method: clazz -> methodID -> argument array -> obj = "camljava_CallStaticObjectMethod" external call_static_boolean_method: clazz -> methodID -> argument array -> bool = "camljava_CallStaticBooleanMethod" external call_static_byte_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticByteMethod" external call_static_char_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticCharMethod" external call_static_short_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticShortMethod" external call_static_int_method: clazz -> methodID -> argument array -> int32 = "camljava_CallStaticIntMethod" external call_static_camlint_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticCamlintMethod" external call_static_long_method: clazz -> methodID -> argument array -> int64 = "camljava_CallStaticLongMethod" external call_static_float_method: clazz -> methodID -> argument array -> float = "camljava_CallStaticFloatMethod" external call_static_double_method: clazz -> methodID -> argument array -> float = "camljava_CallStaticDoubleMethod" external call_static_void_method: clazz -> methodID -> argument array -> unit = "camljava_CallStaticVoidMethod" external call_nonvirtual_object_method: obj -> clazz -> methodID -> argument array -> obj = "camljava_CallNonvirtualObjectMethod" external call_nonvirtual_boolean_method: obj -> clazz -> methodID -> argument array -> bool = "camljava_CallNonvirtualBooleanMethod" external call_nonvirtual_byte_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualByteMethod" external call_nonvirtual_char_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualCharMethod" external call_nonvirtual_short_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualShortMethod" external call_nonvirtual_int_method: obj -> clazz -> methodID -> argument array -> int32 = "camljava_CallNonvirtualIntMethod" external call_nonvirtual_camlint_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualCamlintMethod" external call_nonvirtual_long_method: obj -> clazz -> methodID -> argument array -> int64 = "camljava_CallNonvirtualLongMethod" external call_nonvirtual_float_method: obj -> clazz -> methodID -> argument array -> float = "camljava_CallNonvirtualFloatMethod" external call_nonvirtual_double_method: obj -> clazz -> methodID -> argument array -> float = "camljava_CallNonvirtualDoubleMethod" external call_nonvirtual_void_method: obj -> clazz -> methodID -> argument array -> unit = "camljava_CallNonvirtualVoidMethod" (* Arrays *) external get_array_length: obj -> int = "camljava_GetArrayLength" external new_object_array: int -> clazz -> obj = "camljava_NewObjectArray" external get_object_array_element: obj -> int -> obj = "camljava_GetObjectArrayElement" external set_object_array_element: obj -> int -> obj -> unit = "camljava_SetObjectArrayElement" external new_boolean_array: int -> obj = "camljava_NewBooleanArray" external get_boolean_array_element: obj -> int -> bool = "camljava_GetBooleanArrayElement" external set_boolean_array_element: obj -> int -> bool -> unit = "camljava_SetBooleanArrayElement" external new_byte_array: int -> obj = "camljava_NewByteArray" external get_byte_array_element: obj -> int -> int = "camljava_GetByteArrayElement" external set_byte_array_element: obj -> int -> int -> unit = "camljava_SetByteArrayElement" external get_byte_array_region: obj -> int -> string -> int -> int -> unit = "camljava_GetByteArrayRegion" external set_byte_array_region: string -> int -> obj -> int -> int -> unit = "camljava_SetByteArrayRegion" external new_char_array: int -> obj = "camljava_NewCharArray" external get_char_array_element: obj -> int -> int = "camljava_GetCharArrayElement" external set_char_array_element: obj -> int -> int -> unit = "camljava_SetCharArrayElement" external new_short_array: int -> obj = "camljava_NewShortArray" external get_short_array_element: obj -> int -> int = "camljava_GetShortArrayElement" external set_short_array_element: obj -> int -> int -> unit = "camljava_SetShortArrayElement" external new_int_array: int -> obj = "camljava_NewIntArray" external get_int_array_element: obj -> int -> int32 = "camljava_GetIntArrayElement" external set_int_array_element: obj -> int -> int32 -> unit = "camljava_SetIntArrayElement" external get_camlint_array_element: obj -> int -> int = "camljava_GetCamlintArrayElement" external set_camlint_array_element: obj -> int -> int -> unit = "camljava_SetCamlintArrayElement" external new_long_array: int -> obj = "camljava_NewLongArray" external get_long_array_element: obj -> int -> int64 = "camljava_GetLongArrayElement" external set_long_array_element: obj -> int -> int64 -> unit = "camljava_SetLongArrayElement" external new_float_array: int -> obj = "camljava_NewFloatArray" external get_float_array_element: obj -> int -> float = "camljava_GetFloatArrayElement" external set_float_array_element: obj -> int -> float -> unit = "camljava_SetFloatArrayElement" external new_double_array: int -> obj = "camljava_NewDoubleArray" external get_double_array_element: obj -> int -> float = "camljava_GetDoubleArrayElement" external set_double_array_element: obj -> int -> float -> unit = "camljava_SetDoubleArrayElement" (* Auxiliaries for Java->OCaml callbacks *) val wrap_object: < .. > -> obj camljava-camljava04/lib/jni.mlp000066400000000000000000000355721362667546500166540ustar00rootroot00000000000000(***********************************************************************) (* *) (* OCamlJava: Objective Caml / Java interface *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License. *) (* *) (***********************************************************************) (* $Id: jni.mlp,v 1.4 2005-10-21 08:19:11 xleroy Exp $ *) (* Low-level Java interface (JNI level) *) external set_debug: bool -> unit = "camljava_set_debug" external set_string_auto_conv: bool -> unit = "camljava_set_strconv" external init: string -> unit = "camljava_Init" external shutdown: unit -> unit = "camljava_Shutdown" let _ = let libpath = "%PATH%" in let sep = match Sys.os_type with "Unix" -> ":" | "Win32" -> ";" | _ -> assert false in let path = try Sys.getenv "CLASSPATH" ^ sep ^ libpath with Not_found -> libpath in init path; at_exit shutdown type obj external get_null: unit -> obj = "camljava_GetNull" let null = get_null() exception Null_pointer let _ = Callback.register_exception "camljava_null_pointer" Null_pointer exception Exception of obj let _ = Callback.register "camljava_raise_exception" (fun obj -> raise (Exception obj)) external register_natives: unit -> unit = "camljava_RegisterNatives" let _ = register_natives() let _ = Callback.register "Oo.new_method" Oo.new_method (* String operations *) external string_to_java: string -> obj = "camljava_MakeJavaString" external string_from_java: obj -> string = "camljava_ExtractJavaString" let null_string = "" let is_null_string s = s == null_string external register_null_string: string -> unit = "camljava_RegisterNullString" let _ = register_null_string null_string (* Class operations *) type clazz (* The type of class identifiers *) external find_class: string -> clazz = "camljava_FindClass" external get_superclass: clazz -> clazz = "camljava_GetSuperclass" external is_assignable_from: clazz -> clazz -> bool = "camljava_IsAssignableFrom" (* Field and method identifiers *) type fieldID type methodID external get_fieldID: clazz -> string -> string -> fieldID = "camljava_GetFieldID" external get_static_fieldID: clazz -> string -> string -> fieldID = "camljava_GetStaticFieldID" external get_methodID: clazz -> string -> string -> methodID = "camljava_GetMethodID" external get_static_methodID: clazz -> string -> string -> methodID = "camljava_GetStaticMethodID" (* Field access *) external get_object_field: obj -> fieldID -> obj = "camljava_GetObjectField" external get_boolean_field: obj -> fieldID -> bool = "camljava_GetBooleanField" external get_byte_field: obj -> fieldID -> int = "camljava_GetByteField" external get_char_field: obj -> fieldID -> int = "camljava_GetCharField" external get_short_field: obj -> fieldID -> int = "camljava_GetShortField" external get_int_field: obj -> fieldID -> int32 = "camljava_GetIntField" external get_camlint_field: obj -> fieldID -> int = "camljava_GetCamlintField" external get_long_field: obj -> fieldID -> int64 = "camljava_GetLongField" external get_float_field: obj -> fieldID -> float = "camljava_GetFloatField" external get_double_field: obj -> fieldID -> float = "camljava_GetDoubleField" external set_object_field: obj -> fieldID -> obj -> unit = "camljava_SetObjectField" external set_boolean_field: obj -> fieldID -> bool -> unit = "camljava_SetBooleanField" external set_byte_field: obj -> fieldID -> int -> unit = "camljava_SetByteField" external set_char_field: obj -> fieldID -> int -> unit = "camljava_SetCharField" external set_short_field: obj -> fieldID -> int -> unit = "camljava_SetShortField" external set_int_field: obj -> fieldID -> int32 -> unit = "camljava_SetIntField" external set_camlint_field: obj -> fieldID -> int -> unit = "camljava_SetCamlintField" external set_long_field: obj -> fieldID -> int64 -> unit = "camljava_SetLongField" external set_float_field: obj -> fieldID -> float -> unit = "camljava_SetFloatField" external set_double_field: obj -> fieldID -> float -> unit = "camljava_SetDoubleField" external get_static_object_field: clazz -> fieldID -> obj = "camljava_GetStaticObjectField" external get_static_boolean_field: clazz -> fieldID -> bool = "camljava_GetStaticBooleanField" external get_static_byte_field: clazz -> fieldID -> int = "camljava_GetStaticByteField" external get_static_char_field: clazz -> fieldID -> int = "camljava_GetStaticCharField" external get_static_short_field: clazz -> fieldID -> int = "camljava_GetStaticShortField" external get_static_int_field: clazz -> fieldID -> int32 = "camljava_GetStaticIntField" external get_static_camlint_field: clazz -> fieldID -> int = "camljava_GetStaticCamlintField" external get_static_long_field: clazz -> fieldID -> int64 = "camljava_GetStaticLongField" external get_static_float_field: clazz -> fieldID -> float = "camljava_GetStaticFloatField" external get_static_double_field: clazz -> fieldID -> float = "camljava_GetStaticDoubleField" external set_static_obj_field: clazz -> fieldID -> obj -> unit = "camljava_SetStaticObjectField" external set_static_boolean_field: clazz -> fieldID -> bool -> unit = "camljava_SetStaticBooleanField" external set_static_byte_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticByteField" external set_static_char_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticCharField" external set_static_short_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticShortField" external set_static_int_field: clazz -> fieldID -> int32 -> unit = "camljava_SetStaticIntField" external set_static_camlint_field: clazz -> fieldID -> int -> unit = "camljava_SetStaticCamlintField" external set_static_long_field: clazz -> fieldID -> int64 -> unit = "camljava_SetStaticLongField" external set_static_float_field: clazz -> fieldID -> float -> unit = "camljava_SetStaticFloatField" external set_static_double_field: clazz -> fieldID -> float -> unit = "camljava_SetStaticDoubleField" type argument = Boolean of bool | Byte of int | Char of int | Short of int | Camlint of int | Int of int32 | Long of int64 | Float of float | Double of float | Obj of obj external call_object_method: obj -> methodID -> argument array -> obj = "camljava_CallObjectMethod" external call_boolean_method: obj -> methodID -> argument array -> bool = "camljava_CallBooleanMethod" external call_byte_method: obj -> methodID -> argument array -> int = "camljava_CallByteMethod" external call_char_method: obj -> methodID -> argument array -> int = "camljava_CallCharMethod" external call_short_method: obj -> methodID -> argument array -> int = "camljava_CallShortMethod" external call_int_method: obj -> methodID -> argument array -> int32 = "camljava_CallIntMethod" external call_camlint_method: obj -> methodID -> argument array -> int = "camljava_CallCamlintMethod" external call_long_method: obj -> methodID -> argument array -> int64 = "camljava_CallLongMethod" external call_float_method: obj -> methodID -> argument array -> float = "camljava_CallFloatMethod" external call_double_method: obj -> methodID -> argument array -> float = "camljava_CallDoubleMethod" external call_void_method: obj -> methodID -> argument array -> unit = "camljava_CallVoidMethod" external call_static_object_method: clazz -> methodID -> argument array -> obj = "camljava_CallStaticObjectMethod" external call_static_boolean_method: clazz -> methodID -> argument array -> bool = "camljava_CallStaticBooleanMethod" external call_static_byte_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticByteMethod" external call_static_char_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticCharMethod" external call_static_short_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticShortMethod" external call_static_int_method: clazz -> methodID -> argument array -> int32 = "camljava_CallStaticIntMethod" external call_static_camlint_method: clazz -> methodID -> argument array -> int = "camljava_CallStaticCamlintMethod" external call_static_long_method: clazz -> methodID -> argument array -> int64 = "camljava_CallStaticLongMethod" external call_static_float_method: clazz -> methodID -> argument array -> float = "camljava_CallStaticFloatMethod" external call_static_double_method: clazz -> methodID -> argument array -> float = "camljava_CallStaticDoubleMethod" external call_static_void_method: clazz -> methodID -> argument array -> unit = "camljava_CallStaticVoidMethod" external call_nonvirtual_object_method: obj -> clazz -> methodID -> argument array -> obj = "camljava_CallNonvirtualObjectMethod" external call_nonvirtual_boolean_method: obj -> clazz -> methodID -> argument array -> bool = "camljava_CallNonvirtualBooleanMethod" external call_nonvirtual_byte_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualByteMethod" external call_nonvirtual_char_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualCharMethod" external call_nonvirtual_short_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualShortMethod" external call_nonvirtual_int_method: obj -> clazz -> methodID -> argument array -> int32 = "camljava_CallNonvirtualIntMethod" external call_nonvirtual_camlint_method: obj -> clazz -> methodID -> argument array -> int = "camljava_CallNonvirtualCamlintMethod" external call_nonvirtual_long_method: obj -> clazz -> methodID -> argument array -> int64 = "camljava_CallNonvirtualLongMethod" external call_nonvirtual_float_method: obj -> clazz -> methodID -> argument array -> float = "camljava_CallNonvirtualFloatMethod" external call_nonvirtual_double_method: obj -> clazz -> methodID -> argument array -> float = "camljava_CallNonvirtualDoubleMethod" external call_nonvirtual_void_method: obj -> clazz -> methodID -> argument array -> unit = "camljava_CallNonvirtualVoidMethod" (* Arrays *) external get_array_length: obj -> int = "camljava_GetArrayLength" external new_object_array: int -> clazz -> obj = "camljava_NewObjectArray" external get_object_array_element: obj -> int -> obj = "camljava_GetObjectArrayElement" external set_object_array_element: obj -> int -> obj -> unit = "camljava_SetObjectArrayElement" external new_boolean_array: int -> obj = "camljava_NewBooleanArray" external get_boolean_array_element: obj -> int -> bool = "camljava_GetBooleanArrayElement" external set_boolean_array_element: obj -> int -> bool -> unit = "camljava_SetBooleanArrayElement" external new_byte_array: int -> obj = "camljava_NewByteArray" external get_byte_array_element: obj -> int -> int = "camljava_GetByteArrayElement" external set_byte_array_element: obj -> int -> int -> unit = "camljava_SetByteArrayElement" external get_byte_array_region: obj -> int -> string -> int -> int -> unit = "camljava_GetByteArrayRegion" external set_byte_array_region: string -> int -> obj -> int -> int -> unit = "camljava_SetByteArrayRegion" external new_char_array: int -> obj = "camljava_NewCharArray" external get_char_array_element: obj -> int -> int = "camljava_GetCharArrayElement" external set_char_array_element: obj -> int -> int -> unit = "camljava_SetCharArrayElement" external new_short_array: int -> obj = "camljava_NewShortArray" external get_short_array_element: obj -> int -> int = "camljava_GetShortArrayElement" external set_short_array_element: obj -> int -> int -> unit = "camljava_SetShortArrayElement" external new_int_array: int -> obj = "camljava_NewIntArray" external get_int_array_element: obj -> int -> int32 = "camljava_GetIntArrayElement" external set_int_array_element: obj -> int -> int32 -> unit = "camljava_SetIntArrayElement" external get_camlint_array_element: obj -> int -> int = "camljava_GetCamlintArrayElement" external set_camlint_array_element: obj -> int -> int -> unit = "camljava_SetCamlintArrayElement" external new_long_array: int -> obj = "camljava_NewLongArray" external get_long_array_element: obj -> int -> int64 = "camljava_GetLongArrayElement" external set_long_array_element: obj -> int -> int64 -> unit = "camljava_SetLongArrayElement" external new_float_array: int -> obj = "camljava_NewFloatArray" external get_float_array_element: obj -> int -> float = "camljava_GetFloatArrayElement" external set_float_array_element: obj -> int -> float -> unit = "camljava_SetFloatArrayElement" external new_double_array: int -> obj = "camljava_NewDoubleArray" external get_double_array_element: obj -> int -> float = "camljava_GetDoubleArrayElement" external set_double_array_element: obj -> int -> float -> unit = "camljava_SetDoubleArrayElement" (* Object operations *) external is_null: obj -> bool = "camljava_IsNull" external alloc_object: clazz -> obj = "camljava_AllocObject" external get_object_class: obj -> clazz = "camljava_GetObjectClass" external is_instance_of: obj -> clazz -> bool = "camljava_IsInstanceOf" external is_same_object: obj -> obj -> bool = "camljava_IsSameObject" (* Auxiliaries for Java->OCaml callbacks *) external wrap_caml_object : < .. > -> int64 = "camljava_WrapCamlObject" let callback_class = find_class "fr/inria/caml/camljava/Callback" let callback_init = get_methodID callback_class "" "(J)V" let wrap_object camlobj = let javaobj = alloc_object callback_class in call_nonvirtual_void_method javaobj callback_class callback_init [|Long (wrap_caml_object camlobj)|]; javaobj camljava-camljava04/lib/jnistubs.c000066400000000000000000001073131362667546500173600ustar00rootroot00000000000000#include #include #include #include #include #include #include #include #include static JavaVM * jvm; static JNIEnv * jenv; #define Val_jboolean(b) ((b) == JNI_FALSE ? Val_false : Val_true) #define Jboolean_val(v) (Val_bool(v) ? JNI_TRUE : JNI_FALSE) /********** Threading *************/ static JNIEnv * g_jenv; void init_threading() { g_jenv = jenv; } void camljava_check_main_thread() { if(jenv != g_jenv) { fprintf(stderr, "CamlJava: callbacks from threads other than main are not allowed: ABORT.\n"); fflush(stderr); // raise a Java exception would be better exit(2); } return; } /************ Wrapping of Java objects as Caml values *************/ #define JObject(v) (*((jobject *) Data_custom_val(v))) static void finalize_jobject(value v) { jobject obj = JObject(v); if (obj != NULL) (*jenv)->DeleteGlobalRef(jenv, obj); } static struct custom_operations jobject_ops = { "java.lang.Object", finalize_jobject, custom_compare_default, /* TODO? call equals() or compareTo() */ custom_hash_default, /* TODO? call hashCode() */ custom_serialize_default, /* TODO? use Java serialization intf */ custom_deserialize_default /* TODO? use Java serialization intf */ }; static value alloc_jobject(jobject obj) { value v = alloc_custom(&jobject_ops, sizeof(jobject), 0, 1); if (obj != NULL) { obj = (*jenv)->NewGlobalRef(jenv, obj); if (obj == NULL) raise_out_of_memory(); } JObject(v) = obj; return v; } value camljava_GetNull(value unit) { return alloc_jobject(NULL); } value camljava_IsNull(value vobj) { return Val_bool(JObject(vobj) == NULL); } /*********** Reflecting Java exceptions as Caml exceptions *************/ static int debug = 0; value camljava_set_debug(value v) { debug = Bool_val(v); return Val_unit; } static void check_java_exception(void) { jthrowable exn; value vobj; static const value * camljava_raise_exception = NULL; exn = (*jenv)->ExceptionOccurred(jenv); if (exn != NULL) { if(debug) { /* For debugging */ (*jenv)->ExceptionDescribe(jenv); } (*jenv)->ExceptionClear(jenv); /* TODO: check Caml exception embedded into Java exception */ if (camljava_raise_exception == NULL) { camljava_raise_exception = caml_named_value("camljava_raise_exception"); if (camljava_raise_exception == NULL) invalid_argument("Java_lang not linked in"); } vobj = alloc_jobject(exn); (*jenv)->DeleteLocalRef(jenv, exn); callback(*camljava_raise_exception, vobj); } } static void check_non_null(value jobj) { static const value * camljava_null_pointer; if (JObject(jobj) != NULL) return; if (camljava_null_pointer == NULL) { camljava_null_pointer = caml_named_value("camljava_null_pointer"); if (camljava_null_pointer == NULL) invalid_argument("Java not linked in"); } raise_constant(*camljava_null_pointer); } /*********** Class operations ************/ value camljava_FindClass(value vname) { jclass c = (*jenv)->FindClass(jenv, String_val(vname)); if (c == NULL) check_java_exception(); return alloc_jobject(c); } value camljava_GetSuperclass(value vclass) { jclass c = (*jenv)->GetSuperclass(jenv, JObject(vclass)); if (c == NULL) check_java_exception(); return alloc_jobject(c); } value camljava_IsAssignableFrom(value vclass1, value vclass2) { jboolean b = (*jenv)->IsAssignableFrom(jenv, JObject(vclass1), JObject(vclass2)); return Val_jboolean(b); } /*********** Field IDs ***************/ #define JField(v) (*((jfieldID *) (v))) static value alloc_jfieldID(jfieldID id) { value v = alloc((sizeof(jfieldID) + sizeof(value) - 1) / sizeof(value), Abstract_tag); JField(v) = id; return v; } value camljava_GetFieldID(value vclass, value vname, value vsig) { jfieldID id = (*jenv)->GetFieldID(jenv, JObject(vclass), String_val(vname), String_val(vsig)); if (id == NULL) check_java_exception(); return alloc_jfieldID(id); } value camljava_GetStaticFieldID(value vclass, value vname, value vsig) { jfieldID id = (*jenv)->GetStaticFieldID(jenv, JObject(vclass), String_val(vname), String_val(vsig)); if (id == NULL) check_java_exception(); return alloc_jfieldID(id); } /*********** Field access *************/ #define GETFIELD(name,restyp,resconv) \ value camljava_##name(value vobj, value vfield) \ { \ restyp res; \ check_non_null(vobj); \ res = (*jenv)->name(jenv, JObject(vobj), JField(vfield)); \ return resconv(res); \ } GETFIELD(GetObjectField, jobject, alloc_jobject) GETFIELD(GetBooleanField, jboolean, Val_jboolean) GETFIELD(GetByteField, jbyte, Val_int) GETFIELD(GetCharField, jchar, Val_int) GETFIELD(GetShortField, jshort, Val_int) GETFIELD(GetIntField, jint, copy_int32) GETFIELD(GetLongField, jlong, copy_int64) GETFIELD(GetFloatField, jfloat, copy_double) GETFIELD(GetDoubleField, jdouble, copy_double) value camljava_GetCamlintField(value vobj, value vfield) { jint res; check_non_null(vobj); res = (*jenv)->GetIntField(jenv, JObject(vobj), JField(vfield)); return Val_int(res); } #define SETFIELD(name,argtyp,argconv) \ value camljava_##name(value vobj, value vfield, value vnewval) \ { \ argtyp arg = argconv(vnewval); \ check_non_null(vobj); \ (*jenv)->name(jenv, JObject(vobj), JField(vfield), arg); \ return Val_unit; \ } SETFIELD(SetObjectField, jobject, JObject) SETFIELD(SetBooleanField, jboolean, Jboolean_val) SETFIELD(SetByteField, jbyte, Int_val) SETFIELD(SetCharField, jchar, Int_val) SETFIELD(SetShortField, jshort, Int_val) SETFIELD(SetIntField, jint, Int32_val) SETFIELD(SetLongField, jlong, Int64_val) SETFIELD(SetFloatField, jfloat, Double_val) SETFIELD(SetDoubleField, jdouble, Double_val) value camljava_SetCamlintField(value vobj, value vfield, value vnewval) { jint arg = Int_val(vnewval); check_non_null(vobj); (*jenv)->SetIntField(jenv, JObject(vobj), JField(vfield), arg); return Val_unit; } #define GETSTATICFIELD(name,restyp,resconv) \ value camljava_##name(value vclass, value vfield) \ { \ restyp res = (*jenv)->name(jenv, JObject(vclass), JField(vfield)); \ return resconv(res); \ } GETSTATICFIELD(GetStaticObjectField, jobject, alloc_jobject) GETSTATICFIELD(GetStaticBooleanField, jboolean, Val_jboolean) GETSTATICFIELD(GetStaticByteField, jbyte, Val_int) GETSTATICFIELD(GetStaticCharField, jchar, Val_int) GETSTATICFIELD(GetStaticShortField, jshort, Val_int) GETSTATICFIELD(GetStaticIntField, jint, copy_int32) GETSTATICFIELD(GetStaticLongField, jlong, copy_int64) GETSTATICFIELD(GetStaticFloatField, jfloat, copy_double) GETSTATICFIELD(GetStaticDoubleField, jdouble, copy_double) value camljava_GetStaticCamlintField(value vclass, value vfield) { jint res = (*jenv)->GetStaticIntField(jenv, JObject(vclass), JField(vfield)); return Val_int(res); } #define SETSTATICFIELD(name,argtyp,argconv) \ value camljava_##name(value vclass, value vfield, value vnewval) \ { \ argtyp arg = argconv(vnewval); \ (*jenv)->name(jenv, JObject(vclass), JField(vfield), arg); \ return Val_unit; \ } SETSTATICFIELD(SetStaticObjectField, jobject, JObject) SETSTATICFIELD(SetStaticBooleanField, jboolean, Jboolean_val) SETSTATICFIELD(SetStaticByteField, jbyte, Int_val) SETSTATICFIELD(SetStaticCharField, jchar, Int_val) SETSTATICFIELD(SetStaticShortField, jshort, Int_val) SETSTATICFIELD(SetStaticIntField, jint, Int32_val) SETSTATICFIELD(SetStaticLongField, jlong, Int64_val) SETSTATICFIELD(SetStaticFloatField, jfloat, Double_val) SETSTATICFIELD(SetStaticDoubleField, jdouble, Double_val) value camljava_SetStaticCamlintField(value vclass, value vfield, value vnewval) { jint arg = Val_int(vnewval); (*jenv)->SetStaticIntField(jenv, JObject(vclass), JField(vfield), arg); return Val_unit; } /*********** Method IDs ***************/ #define JMethod(v) (*((jmethodID *) (v))) static value alloc_jmethodID(jmethodID id) { value v = alloc((sizeof(jmethodID) + sizeof(value) - 1) / sizeof(value), Abstract_tag); JMethod(v) = id; return v; } value camljava_GetMethodID(value vclass, value vname, value vsig) { jmethodID id = (*jenv)->GetMethodID(jenv, JObject(vclass), String_val(vname), String_val(vsig)); if (id == NULL) check_java_exception(); return alloc_jmethodID(id); } value camljava_GetStaticMethodID(value vclass, value vname, value vsig) { jmethodID id = (*jenv)->GetStaticMethodID(jenv, JObject(vclass), String_val(vname), String_val(vsig)); if (id == NULL) check_java_exception(); return alloc_jmethodID(id); } /*************** The jvalue union ***************/ enum { Tag_Boolean, Tag_Byte, Tag_Char, Tag_Short, Tag_Camlint, Tag_Int, Tag_Long, Tag_Float, Tag_Double, Tag_Object }; static void jvalue_val(value v, /*out*/ jvalue * j) { switch (Tag_val(v)) { case Tag_Boolean: j->z = Jboolean_val(Field(v, 0)); case Tag_Byte: j->b = Int_val(Field(v, 0)); break; case Tag_Char: j->c = Int_val(Field(v, 0)); break; case Tag_Short: j->s = Int_val(Field(v, 0)); break; case Tag_Camlint: j->i = Int_val(Field(v, 0)); break; case Tag_Int: j->i = Int32_val(Field(v, 0)); break; case Tag_Long: j->j = Int64_val(Field(v, 0)); break; case Tag_Float: j->f = Double_val(Field(v, 0)); break; case Tag_Double: j->d = Double_val(Field(v, 0)); break; case Tag_Object: j->l = JObject(Field(v, 0)); break; } } #define NUM_DEFAULT_ARGS 8 static jvalue * convert_args(value vargs, jvalue default_args[]) { mlsize_t nargs = Wosize_val(vargs); jvalue * args; mlsize_t i; if (nargs <= NUM_DEFAULT_ARGS) args = default_args; else args = stat_alloc(nargs * sizeof(jvalue)); for (i = 0; i < nargs; i++) jvalue_val(Field(vargs, i), &(args[i])); return args; } /************* Method invocation **************/ #define CALLMETHOD(callname,restyp,resconv) \ value camljava_##callname(value vobj, value vmeth, value vargs) \ { \ jvalue default_args[NUM_DEFAULT_ARGS]; \ jvalue * args; \ restyp res; \ check_non_null(vobj); \ args = convert_args(vargs, default_args); \ res = (*jenv)->callname##A(jenv, JObject(vobj), JMethod(vmeth), args); \ if (args != default_args) stat_free(args); \ check_java_exception(); \ return resconv(res); \ } CALLMETHOD(CallObjectMethod, jobject, alloc_jobject) CALLMETHOD(CallBooleanMethod, jboolean, Val_jboolean) CALLMETHOD(CallByteMethod, jbyte, Val_int) CALLMETHOD(CallCharMethod, jchar, Val_int) CALLMETHOD(CallShortMethod, jshort, Val_int) CALLMETHOD(CallIntMethod, jint, copy_int32) CALLMETHOD(CallLongMethod, jlong, copy_int64) CALLMETHOD(CallFloatMethod, jfloat, copy_double) CALLMETHOD(CallDoubleMethod, jdouble, copy_double) value camljava_CallCamlintMethod(value vobj, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args; jint res; check_non_null(vobj); args = convert_args(vargs, default_args); res = (*jenv)->CallIntMethodA(jenv, JObject(vobj), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_int(res); } value camljava_CallVoidMethod(value vobj, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args; check_non_null(vobj); args = convert_args(vargs, default_args); (*jenv)->CallVoidMethodA(jenv, JObject(vobj), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_unit; } #define CALLSTATICMETHOD(callname,restyp,resconv) \ value camljava_##callname(value vclass, value vmeth, value vargs) \ { \ jvalue default_args[NUM_DEFAULT_ARGS]; \ jvalue * args = convert_args(vargs, default_args); \ restyp res = \ (*jenv)->callname##A(jenv, JObject(vclass), JMethod(vmeth), args); \ if (args != default_args) stat_free(args); \ check_java_exception(); \ return resconv(res); \ } CALLSTATICMETHOD(CallStaticObjectMethod, jobject, alloc_jobject) CALLSTATICMETHOD(CallStaticBooleanMethod, jboolean, Val_int) CALLSTATICMETHOD(CallStaticByteMethod, jbyte, Val_int) CALLSTATICMETHOD(CallStaticCharMethod, jchar, Val_int) CALLSTATICMETHOD(CallStaticShortMethod, jshort, Val_int) CALLSTATICMETHOD(CallStaticIntMethod, jint, copy_int32) CALLSTATICMETHOD(CallStaticLongMethod, jlong, copy_int64) CALLSTATICMETHOD(CallStaticFloatMethod, jfloat, copy_double) CALLSTATICMETHOD(CallStaticDoubleMethod, jdouble, copy_double) value camljava_CallStaticCamlintMethod(value vclass, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args = convert_args(vargs, default_args); jint res = (*jenv)->CallStaticIntMethodA(jenv, JObject(vclass), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_int(res); } value camljava_CallStaticVoidMethod(value vclass, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args = convert_args(vargs, default_args); (*jenv)->CallStaticVoidMethodA(jenv, JObject(vclass), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_unit; } #define CALLNONVIRTUALMETHOD(callname,restyp,resconv) \ value camljava_##callname(value vobj, value vclass, value vmeth, value vargs)\ { \ jvalue default_args[NUM_DEFAULT_ARGS]; \ jvalue * args; \ restyp res; \ check_non_null(vobj); \ args = convert_args(vargs, default_args); \ res = (*jenv)->callname##A(jenv, JObject(vobj), JObject(vclass), \ JMethod(vmeth), args); \ if (args != default_args) stat_free(args); \ check_java_exception(); \ return resconv(res); \ } CALLNONVIRTUALMETHOD(CallNonvirtualObjectMethod, jobject, alloc_jobject) CALLNONVIRTUALMETHOD(CallNonvirtualBooleanMethod, jboolean, Val_int) CALLNONVIRTUALMETHOD(CallNonvirtualByteMethod, jbyte, Val_int) CALLNONVIRTUALMETHOD(CallNonvirtualCharMethod, jchar, Val_int) CALLNONVIRTUALMETHOD(CallNonvirtualShortMethod, jshort, Val_int) CALLNONVIRTUALMETHOD(CallNonvirtualIntMethod, jint, copy_int32) CALLNONVIRTUALMETHOD(CallNonvirtualLongMethod, jlong, copy_int64) CALLNONVIRTUALMETHOD(CallNonvirtualFloatMethod, jfloat, copy_double) CALLNONVIRTUALMETHOD(CallNonvirtualDoubleMethod, jdouble, copy_double) value camljava_CallNonvirtualCamlintMethod(value vobj, value vclass, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args; jint res; check_non_null(vobj); args = convert_args(vargs, default_args); res = (*jenv)->CallNonvirtualIntMethodA(jenv, JObject(vobj), JObject(vclass), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_int(res); } value camljava_CallNonvirtualVoidMethod(value vobj, value vclass, value vmeth, value vargs) { jvalue default_args[NUM_DEFAULT_ARGS]; jvalue * args; check_non_null(vobj); args = convert_args(vargs, default_args); (*jenv)->CallNonvirtualVoidMethodA(jenv, JObject(vobj), JObject(vclass), JMethod(vmeth), args); if (args != default_args) stat_free(args); check_java_exception(); return Val_unit; } /************** Strings ********************/ /* Note: by lack of wide strings in Caml, we map Java strings to UTF8-encoded Caml strings */ static value camljava_null_string; value camljava_RegisterNullString(value null_string) { camljava_null_string = null_string; register_global_root(&camljava_null_string); return Val_unit; } value camljava_MakeJavaString (value vstr) { jstring jstr; if (vstr == camljava_null_string) jstr = NULL; else { jstr = (*jenv)->NewStringUTF(jenv, String_val(vstr)); if (jstr == NULL) check_java_exception(); } return alloc_jobject(jstr); } /* Automatically convert Java string to Caml string? True by default; globally set to false by O'Jacare. */ static int string_auto_conv = 1; value camljava_set_strconv(value v) { string_auto_conv = Bool_val(v); return Val_unit; } static value extract_java_string (JNIEnv * env, jstring jstr) { jsize len; value res; jboolean isCopy; const char * chrs; if (jstr == NULL) return camljava_null_string; len = (*env)->GetStringUTFLength(env, jstr); res = alloc_string(len); chrs = (*env)->GetStringUTFChars(env, jstr, &isCopy); memcpy(String_val(res), chrs, len); (*env)->ReleaseStringUTFChars(env, jstr, chrs); return res; } value camljava_ExtractJavaString (value vobj) { value res; Begin_root(vobj) /* prevent deallocation of Java string */ res = extract_java_string(jenv, (jstring) JObject(vobj)); End_roots(); return res; } /******************** Arrays *******************/ value camljava_GetArrayLength(value varray) { jsize len; check_non_null(varray); len = (*jenv)->GetArrayLength(jenv, (jarray) JObject(varray)); return Val_int(len); } value camljava_NewObjectArray(value vsize, value vclass) { jobjectArray arr = (*jenv)->NewObjectArray(jenv, Int_val(vsize), (jclass) JObject(vclass), NULL); if (arr == NULL) check_java_exception(); return alloc_jobject(arr); } value camljava_GetObjectArrayElement(value varray, value vidx) { jobject res; check_non_null(varray); res = (*jenv)->GetObjectArrayElement(jenv, (jobjectArray) JObject(varray), Int_val(vidx)); check_java_exception(); return alloc_jobject(res); } value camljava_SetObjectArrayElement(value varray, value vidx, value vnewval) { check_non_null(varray); (*jenv)->SetObjectArrayElement(jenv, (jobjectArray) JObject(varray), Int_val(vidx), JObject(vnewval)); check_java_exception(); return Val_unit; } #define ARRAYNEWGETSET(name,array_typ,elt_typ,from_value,to_value) \ value camljava_New##name##Array(value vsize) \ { \ array_typ arr = (*jenv)->New##name##Array(jenv, Int_val(vsize)); \ if (arr == NULL) check_java_exception(); \ return alloc_jobject(arr); \ } \ \ value camljava_Get##name##ArrayElement(value varray, value vidx) \ { \ elt_typ elt; \ check_non_null(varray); \ (*jenv)->Get##name##ArrayRegion(jenv, (array_typ) JObject(varray), \ Int_val(vidx), 1, &elt); \ check_java_exception(); \ return to_value(elt); \ } \ \ value camljava_Set##name##ArrayElement(value varray, value vidx, \ value vnewval) \ { \ elt_typ elt; \ check_non_null(varray); \ elt = from_value(vnewval); \ (*jenv)->Set##name##ArrayRegion(jenv, (array_typ) JObject(varray), \ Int_val(vidx), 1, &elt); \ check_java_exception(); \ return Val_unit; \ } ARRAYNEWGETSET(Boolean, jbooleanArray, jboolean, Jboolean_val, Val_jboolean) ARRAYNEWGETSET(Byte, jbyteArray, jbyte, Int_val, Val_int) ARRAYNEWGETSET(Char, jcharArray, jchar, Int_val, Val_int) ARRAYNEWGETSET(Short, jshortArray, jshort, Int_val, Val_int) ARRAYNEWGETSET(Int, jintArray, jint, Int32_val, copy_int32) ARRAYNEWGETSET(Long, jlongArray, jlong, Int64_val, copy_int64) ARRAYNEWGETSET(Float, jfloatArray, jfloat, Double_val, copy_double) ARRAYNEWGETSET(Double, jdoubleArray, jdouble, Double_val, copy_double) value camljava_GetCamlintArrayElement(value varray, value vidx) { jint elt; check_non_null(varray); (*jenv)->GetIntArrayRegion(jenv, (jintArray) JObject(varray), Int_val(vidx), 1, &elt); check_java_exception(); return Val_int(elt); } value camljava_SetCamlintArrayElement(value varray, value vidx, value vnewval) { jint elt = Int_val(vnewval); check_non_null(varray); (*jenv)->SetIntArrayRegion(jenv, (jintArray) JObject(varray), Int_val(vidx), 1, &elt); check_java_exception(); return Val_unit; } value camljava_GetByteArrayRegion(value varray, value vsrcidx, value vstr, value vdstidx, value vlength) { long srcidx = Long_val(vsrcidx); long dstidx = Long_val(vdstidx); long length = Long_val(vlength); check_non_null(varray); if (dstidx < 0 || length < 0 || dstidx + length > string_length(vstr)) invalid_argument("Jni.get_byte_array_region"); (*jenv)->GetByteArrayRegion(jenv, (jbyteArray) JObject(varray), srcidx, length, (jbyte *) &Byte(vstr, dstidx)); check_java_exception(); return Val_unit; } value camljava_SetByteArrayRegion(value vstr, value vsrcidx, value varray, value vdstidx, value vlength) { long srcidx = Long_val(vsrcidx); long dstidx = Long_val(vdstidx); long length = Long_val(vlength); check_non_null(varray); if (srcidx < 0 || length < 0 || srcidx + length > string_length(vstr)) invalid_argument("Jni.set_byte_array_region"); (*jenv)->SetByteArrayRegion(jenv, (jbyteArray) JObject(varray), dstidx, length, (jbyte *) &Byte(vstr, srcidx)); check_java_exception(); return Val_unit; } /************************ Initialization *************************/ value camljava_Init(value vclasspath) { JavaVMInitArgs vm_args; JavaVMOption options[1]; int retcode; char * classpath; char * setclasspath = "-Djava.class.path="; /* Set the class path */ classpath = stat_alloc(strlen(setclasspath) + string_length(vclasspath) + 1); strcpy(classpath, setclasspath); strcat(classpath, String_val(vclasspath)); options[0].optionString = classpath; vm_args.version = JNI_VERSION_1_2; vm_args.options = options; vm_args.nOptions = 1; vm_args.ignoreUnrecognized = 1; /* Load and initialize a Java VM, return a JNI interface pointer in env */ retcode = JNI_CreateJavaVM(&jvm, (void **) &jenv, &vm_args); stat_free(classpath); if (retcode < 0) failwith("Java.init"); init_threading(); // by O'Jacare return Val_unit; } value camljava_Shutdown(value unit) { (*jvm)->DestroyJavaVM(jvm); return Val_unit; } /****************** Object operations ********************/ value camljava_AllocObject(value vclass) { jobject res = (*jenv)->AllocObject(jenv, JObject(vclass)); if (res == NULL) check_java_exception(); return alloc_jobject(res); } value camljava_GetObjectClass(value vobj) { jclass cls; check_non_null(vobj); cls = (*jenv)->GetObjectClass(jenv, JObject(vobj)); if (cls == NULL) check_java_exception(); return alloc_jobject(cls); } value camljava_IsInstanceOf(value vobj, value vclass) { jboolean res = (*jenv)->IsInstanceOf(jenv, JObject(vobj), JObject(vclass)); check_java_exception(); return Val_jboolean(res); } value camljava_IsSameObject(value vobj1, value vobj2) { return Val_jboolean((*jenv)->IsSameObject(jenv, JObject(vobj1), JObject(vobj2))); } /********************* Callback from Java to Caml ******************/ static jclass caml_boolean, caml_byte, caml_char, caml_short, caml_int, caml_camlint, caml_long, caml_float, caml_double, java_lang_string, caml_exception; static jfieldID caml_boolean_contents, caml_byte_contents, caml_char_contents, caml_short_contents, caml_int_contents, caml_camlint_contents, caml_long_contents, caml_float_contents, caml_double_contents; static int caml_classes_initialized = 0; static int init_caml_classes(JNIEnv * env) { #define INIT_CAML_CLASS(cls,fld,cname,fsig) \ cls = (*env)->FindClass(env, cname); \ if (cls == NULL) return -1; \ cls = (*env)->NewGlobalRef(env, cls); \ if (cls == NULL) return -1; \ fld = (*env)->GetFieldID(env, cls, "contents", fsig); \ if (fld == NULL) return -1; INIT_CAML_CLASS(caml_boolean, caml_boolean_contents, "fr/inria/caml/camljava/Boolean", "Z"); INIT_CAML_CLASS(caml_byte, caml_byte_contents, "fr/inria/caml/camljava/Byte", "B"); INIT_CAML_CLASS(caml_char, caml_char_contents, "fr/inria/caml/camljava/Char", "C"); INIT_CAML_CLASS(caml_short, caml_short_contents, "fr/inria/caml/camljava/Short", "S"); INIT_CAML_CLASS(caml_int, caml_int_contents, "fr/inria/caml/camljava/Int", "I"); INIT_CAML_CLASS(caml_camlint, caml_camlint_contents, "fr/inria/caml/camljava/Camlint", "I"); INIT_CAML_CLASS(caml_long, caml_long_contents, "fr/inria/caml/camljava/Long", "J"); INIT_CAML_CLASS(caml_float, caml_float_contents, "fr/inria/caml/camljava/Float", "F"); INIT_CAML_CLASS(caml_double, caml_double_contents, "fr/inria/caml/camljava/Double", "D"); java_lang_string = (*env)->FindClass(env, "java/lang/String"); if (java_lang_string == NULL) return -1; java_lang_string = (*env)->NewGlobalRef(env, java_lang_string); if (java_lang_string == NULL) return -1; caml_exception = (*env)->FindClass(env, "fr/inria/caml/camljava/Exception"); if (caml_exception == NULL) return -1; caml_exception = (*env)->NewGlobalRef(env, caml_exception); if (caml_exception == NULL) return -1; return 0; #undef INIT_CAML_CLASS } #define CALLBACK_OUT_OF_MEMORY Make_exception_result(0) static value camljava_callback(JNIEnv * env, jlong obj_proxy, jlong method_id, jobjectArray jargs) { JNIEnv * savedenv; int n, i; value * cargs; jobject arg; value carg, clos, res; savedenv = jenv; jenv = env; camljava_check_main_thread(); // by O'Jacare if (!caml_classes_initialized) { if (init_caml_classes(env) == -1) return -1; caml_classes_initialized = 1; } n = 1 + (*env)->GetArrayLength(env, jargs); cargs = malloc(n * sizeof(value)); if (cargs == NULL) { (*env)->ThrowNew(env, (*env)->FindClass(env, "java/lang/OutOfMemoryError"), "Out of memory in Java->Caml callback"); jenv = savedenv; return CALLBACK_OUT_OF_MEMORY; } cargs[0] = *((value *) ((value) obj_proxy)); for (i = 1; i < n; i++) cargs[i] = Val_unit; Begin_roots_block(cargs, n) for (i = 1; i < n; i++) { arg = (*env)->GetObjectArrayElement(env, jargs, i - 1); if (arg == NULL) carg = alloc_jobject(arg); else if ((*env)->IsInstanceOf(env, arg, caml_boolean)) carg = Val_jboolean((*env)->GetBooleanField(env, arg, caml_boolean_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_byte)) carg = Val_int((*env)->GetByteField(env, arg, caml_byte_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_char)) carg = Val_int((*env)->GetCharField(env, arg, caml_char_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_short)) carg = Val_int((*env)->GetShortField(env, arg, caml_short_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_int)) carg = copy_int32((*env)->GetIntField(env, arg, caml_int_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_camlint)) carg = Val_int((*env)->GetIntField(env, arg, caml_camlint_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_long)) carg = copy_int64((*env)->GetLongField(env, arg, caml_long_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_float)) carg = copy_double((*env)->GetFloatField(env, arg, caml_float_contents)); else if ((*env)->IsInstanceOf(env, arg, caml_double)) carg = copy_double((*env)->GetDoubleField(env, arg, caml_double_contents)); else if (string_auto_conv && (*env)->IsInstanceOf(env, arg, java_lang_string)) carg = extract_java_string(env, (jstring) arg); else carg = alloc_jobject(arg); cargs[i] = carg; } End_roots(); clos = caml_get_public_method(cargs[0], (value) method_id); res = callbackN_exn(clos, n, cargs); free(cargs); jenv = savedenv; return res; } static void map_caml_exception(JNIEnv * env, value exn) { value name; exn = Extract_exception(exn); name = Field(Field(exn, 0), 0); (*env)->ThrowNew(env, caml_exception, String_val(name)); } void camljava_CallbackVoid(JNIEnv * env, jclass cls, jlong obj_proxy, jlong method_id, jobjectArray args) { value res = camljava_callback(env, obj_proxy, method_id, args); if (Is_exception_result(res)) map_caml_exception(env, res); } #define CALLBACK(name,restyp,conv) \ restyp camljava_Callback##name(JNIEnv * env, jclass cls, \ jlong obj_proxy, jlong method_id, \ jobjectArray args) \ { \ value res = camljava_callback(env, obj_proxy, method_id, args); \ if (Is_exception_result(res)) { \ map_caml_exception(env, res); \ return 0; /*dummy return value*/ \ } else \ return conv(res); \ } CALLBACK(Boolean, jboolean, Jboolean_val) CALLBACK(Byte, jbyte, Int_val) CALLBACK(Char, jchar, Int_val) CALLBACK(Short, jshort, Int_val) CALLBACK(Camlint, jint, Int_val) CALLBACK(Int, jint, Int32_val) CALLBACK(Long, jlong, Int64_val) CALLBACK(Float, jfloat, Double_val) CALLBACK(Double, jdouble, Double_val) CALLBACK(Object, jobject, JObject) /****************** Auxiliary functions for callbacks *****************/ value camljava_WrapCamlObject(value vobj) { value * wrapper = stat_alloc(sizeof(value)); *wrapper = vobj; register_global_root(wrapper); return copy_int64((jlong) (value) wrapper); } void camljava_FreeWrapper(JNIEnv * env, jclass cls, jlong wrapper) { value * w = (value *) (value) wrapper; remove_global_root(w); stat_free(w); } jlong camljava_GetCamlMethodID(JNIEnv * env, jclass cls, jstring jname) { jboolean isCopy; const char * chrs; value res; chrs = (*env)->GetStringUTFChars(env, jname, &isCopy); res = caml_hash_variant((char *) chrs); (*env)->ReleaseStringUTFChars(env, jname, chrs); return res; } /***************** Registration of native methods with the JNI ************/ static JNINativeMethod camljava_natives[] = { { "callbackVoid", "(JJ[Ljava/lang/Object;)V", (void*)camljava_CallbackVoid }, { "callbackBoolean", "(JJ[Ljava/lang/Object;)Z", (void*)camljava_CallbackBoolean }, { "callbackByte", "(JJ[Ljava/lang/Object;)B", (void*)camljava_CallbackByte }, { "callbackChar", "(JJ[Ljava/lang/Object;)C", (void*)camljava_CallbackChar }, { "callbackShort", "(JJ[Ljava/lang/Object;)S", (void*)camljava_CallbackShort }, { "callbackCamlint", "(JJ[Ljava/lang/Object;)I", (void*)camljava_CallbackCamlint }, { "callbackInt", "(JJ[Ljava/lang/Object;)I", (void*)camljava_CallbackInt }, { "callbackLong", "(JJ[Ljava/lang/Object;)J", (void*)camljava_CallbackLong }, { "callbackFloat", "(JJ[Ljava/lang/Object;)F", (void*)camljava_CallbackFloat }, { "callbackDouble", "(JJ[Ljava/lang/Object;)D", (void*)camljava_CallbackDouble }, { "callbackObject", "(JJ[Ljava/lang/Object;)Ljava/lang/Object;", (void*)camljava_CallbackObject }, { "freeWrapper", "(J)V", (void*)camljava_FreeWrapper }, { "getCamlMethodID", "(Ljava/lang/String;)J", (void*)camljava_GetCamlMethodID } }; value camljava_RegisterNatives(value unit) { jclass cls = (*jenv)->FindClass(jenv, "fr/inria/caml/camljava/Callback"); if (cls == NULL) check_java_exception(); (*jenv)->RegisterNatives(jenv, cls, camljava_natives, sizeof(camljava_natives) / sizeof(JNINativeMethod)); return Val_unit; } /********************* OS-specific hacks ************************/ #ifdef JDK122_LINUX_HACK #include extern void __libc_siglongjmp (sigjmp_buf env, int val) __attribute__ ((noreturn)); void siglongjmp(sigjmp_buf env, int val) { __libc_siglongjmp(env, val); } #endif camljava-camljava04/test/000077500000000000000000000000001362667546500155575ustar00rootroot00000000000000camljava-camljava04/test/.cvsignore000066400000000000000000000000101362667546500175460ustar00rootroot00000000000000jnitest camljava-camljava04/test/Makefile000066400000000000000000000007321362667546500172210ustar00rootroot00000000000000include ../Makefile.config CAMLJAVA_PATH=../lib/camljava.jar CAMLJAVA_DIR=../lib #CAMLJAVA_PATH=`ocamlc -where`/camljava/camljava.jar #CAMLJAVA_DIR=+camljava all: jnitest Test.class Testcb.class CLASSPATH=$(CAMLJAVA_PATH):. ./jnitest jnitest: jnitest.ml ocamlc -ccopt -g -o jnitest -I $(CAMLJAVA_DIR) jni.cma jnitest.ml clean:: rm -f jnitest .SUFFIXES: .java .class .java.class: $(JAVAC) -classpath $(CAMLJAVA_PATH):. $*.java clean:: rm -f *.cm? rm -f *.class camljava-camljava04/test/Makefile.msvc000077500000000000000000000006031362667546500201700ustar00rootroot00000000000000include ../Makefile.config CAMLJAVA=`ocamlc -where`/camljava/camljava.jar all: jnitest.exe Test.class Testcb.class CLASSPATH="." ./jnitest jnitest.exe: jnitest.ml ocamlc -ccopt /Zi -o jnitest.exe -I +camljava jni.cma jnitest.ml clean:: rm -f jnitest.exe .SUFFIXES: .java .class .java.class: $(JAVAC) -classpath "$(CAMLJAVA);." $*.java clean:: rm -f *.cm? camljava-camljava04/test/Test.java000066400000000000000000000005531362667546500173440ustar00rootroot00000000000000class Test { static void f() { System.out.println("f"); } static int g(int x, int y) { System.out.println("g " + x + " " + y); return x + y; } static int a; int b; int h() { System.out.println("h"); return b; } static int k(Testcb cb, int x) { System.out.println("k " + x); cb.f(); return cb.g(x); } } camljava-camljava04/test/Testcb.java000066400000000000000000000006771362667546500176600ustar00rootroot00000000000000import fr.inria.caml.camljava.Callback; class Testcb { private Callback cb; private static long _f = Callback.getCamlMethodID("f"); private static long _g = Callback.getCamlMethodID("g"); public Testcb(Callback c) { cb = c; } public void f() { Object[] args = { }; cb.callVoid(_f, args); } public int g(int x) { Object[] args = { new fr.inria.caml.camljava.Camlint(x) }; return cb.callCamlint(_g, args); } } camljava-camljava04/test/jnitest.ml000066400000000000000000000052631362667546500175770ustar00rootroot00000000000000open Jni class cls = object method f = print_string "cls.f called"; print_newline() method g x = print_string "cls.g called with "; print_int x; print_newline(); x+42 end let wrap_caml_object() = let camlobj = new cls in (* Wrap caml object into instance of Testcb (see Testcb.java) *) let c = find_class "Testcb" in let i = get_methodID c "" "(Lfr/inria/caml/camljava/Callback;)V" in let o = alloc_object c in call_nonvirtual_void_method o c i [|Obj(wrap_object camlobj)|]; o let test() = (* Static method invocation *) let c = find_class "Test" in let f = get_static_methodID c "f" "()V" in print_string "Calling Test.f()"; print_newline(); call_static_void_method c f [||]; let g = get_static_methodID c "g" "(II)I" in print_string "Calling Test.g(12,45)"; print_newline(); let r = call_static_int_method c g [|Camlint 12; Camlint 45|] in print_string "Result is: "; print_string (Int32.to_string r); print_newline(); (* Static field access *) let a = get_static_fieldID c "a" "I" in print_string "Current value of Test.a is: "; print_string (Int32.to_string (get_static_int_field c a)); print_newline(); print_string "Setting Test.a to 12"; print_newline(); set_static_int_field c a (Int32.of_int 12); print_string "Current value of Test.a is: "; print_string (Int32.to_string (get_static_int_field c a)); print_newline(); (* Object creation *) print_string "Creating an instance of Test..."; print_newline(); let o = alloc_object c in let init = get_methodID c "" "()V" in call_nonvirtual_void_method o c init [||]; (* Virtual method invocation *) let h = get_methodID c "h" "()I" in print_string "Calling testinstance.h()"; print_newline(); let r = call_int_method o h [||] in print_string "Result is: "; print_string (Int32.to_string r); print_newline(); (* Instance field access *) let b = get_fieldID c "b" "I" in print_string "Setting testinstance.b to 45"; print_newline(); set_int_field o b (Int32.of_int 45); print_string "Calling testinstance.h()"; print_newline(); let r = call_int_method o h [||] in print_string "Result is: "; print_string (Int32.to_string r); print_newline(); print_string "Current value of testinstance.b is: "; print_string (Int32.to_string (get_int_field o b)); print_newline(); print_string "Wrapping Caml object into Java object..."; print_newline(); let cb = wrap_caml_object() in let k = get_static_methodID c "k" "(LTestcb;I)I" in print_string "Calling Test.k(, 2)"; print_newline(); let r = call_static_int_method c k [|Obj cb; Camlint 2|] in print_string "Result is: "; print_string (Int32.to_string r); print_newline() let _ = test()