#include
#include
#include
#include "rJava.h"
#include
#include
/* determine whether eenv cache should be used (has no effect if JNI_CACHE is not set) */
int use_eenv = 1;
/* cached environment. Do NOT use directly! Always use getJNIEnv()! */
JNIEnv *eenv;
static SEXP getCurrentCall(void) {
SEXP cexp, sys_calls = PROTECT(install("sys.calls"));
cexp = PROTECT(lang1(sys_calls));
SEXP cl = eval(cexp, R_GetCurrentEnv());
UNPROTECT(2);
/* find the last call */
if (TYPEOF(cl) != LISTSXP) return R_NilValue;
while (cl != R_NilValue) {
if (CDR(cl) == R_NilValue && CAR(cl) != R_NilValue)
return CAR(cl);
cl = CDR(cl);
}
return R_NilValue; /* (LENGTH(cl) > 0) ? VECTOR_ELT(cl, 0) : R_NilValue; */
}
/** throw an exception using R condition code.
* @param msg - message string
* @param jobj - jobjRef object of the exception
* @param clazzes - simple name of all the classes in the inheritance tree of the exception plus "error" and "condition"
*/
HIDE void throwR(SEXP msg, SEXP jobj, SEXP clazzes) {
SEXP cond = PROTECT(allocVector(VECSXP, 3));
SEXP names = PROTECT(allocVector(STRSXP, 3));
SET_VECTOR_ELT(cond, 0, msg);
SET_VECTOR_ELT(cond, 1, getCurrentCall());
SET_VECTOR_ELT(cond, 2, jobj);
SET_STRING_ELT(names, 0, mkChar("message"));
SET_STRING_ELT(names, 1, mkChar("call"));
SET_STRING_ELT(names, 2, mkChar("jobj"));
setAttrib(cond, R_NamesSymbol, names);
setAttrib(cond, R_ClassSymbol, clazzes);
UNPROTECT(1); /* names */
eval(PROTECT(LCONS(install("stop"), PROTECT(CONS(cond, R_NilValue)))), R_GlobalEnv);
UNPROTECT(3); /* cond + eval-pars */
}
/* check for exceptions and throw them to R level */
HIDE void ckx(JNIEnv *env) {
SEXP xr, xobj, msg = 0, xclass = 0; /* note: we don't bother counting protections because we never return */
jthrowable x = 0;
if (env && !(x = (*env)->ExceptionOccurred(env))) return;
if (!env) {
env = getJNIEnv();
if (!env)
error("Unable to retrieve JVM environment.");
ckx(env);
return;
}
/* env is valid and an exception occurred */
/* we create the jobj first, because the exception may in theory disappear after being cleared,
yet this can be (also in theory) risky as it uses further JNI calls ... */
xobj = PROTECT(j2SEXP(env, x, 0));
if (!rj_RJavaTools_Class) {
REprintf("ERROR: Java exception occurred during rJava bootstrap - see stderr for Java stack trace.\n");
(*env)->ExceptionDescribe(env);
}
(*env)->ExceptionClear(env);
/* grab the list of class names (without package path) */
SEXP clazzes = PROTECT( rj_RJavaTools_Class ? getSimpleClassNames_asSEXP( (jobject)x, (jboolean)1 ) : R_NilValue );
/* ok, now this is a critical part that we do manually to avoid recursion */
{
jclass cls = (*env)->GetObjectClass(env, x);
if (cls) {
jstring cname;
jmethodID mid = (*env)->GetMethodID(env, cls, "toString", "()Ljava/lang/String;");
if (mid) {
jstring s = (jstring)(*env)->CallObjectMethod(env, x, mid);
if (s) {
const char *c = (*env)->GetStringUTFChars(env, s, 0);
if (c) {
msg = PROTECT(mkString(c));
(*env)->ReleaseStringUTFChars(env, s, c);
}
}
}
/* beside toString() we also need to call getName() on cls to get the subclass */
cname = (jstring) (*env)->CallObjectMethod(env, cls, mid_getName);
if (cname) {
const char *c = (*env)->GetStringUTFChars(env, cname, 0);
if (c) {
/* convert full class name to JNI notation */
char *cn = strdup(c), *d = cn;
while (*d) { if (*d == '.') *d = '/'; d++; }
xclass = PROTECT(mkString(cn));
free(cn);
(*env)->ReleaseStringUTFChars(env, cname, c);
}
(*env)->DeleteLocalRef(env, cname);
}
if ((*env)->ExceptionOccurred(env))
(*env)->ExceptionClear(env);
(*env)->DeleteLocalRef(env, cls);
} else (*env)->ExceptionClear(env);
if (!msg)
msg = PROTECT(mkString("Java Exception "));
}
/* delete the local reference to the exception (jobjRef has a global copy) */
(*env)->DeleteLocalRef(env, x);
/* construct the jobjRef */
xr = PROTECT(NEW_OBJECT(PROTECT(MAKE_CLASS("jobjRef"))));
if (!xclass) xclass = PROTECT(mkString("java/lang/Throwable"));
if (inherits(xr, "jobjRef")) {
SET_SLOT(xr, install("jclass"), xclass);
SET_SLOT(xr, install("jobj"), xobj);
}
/* and off to R .. (we're keeping xr and clazzes protected) */
throwR(msg, xr, clazzes);
/* should not return, but just in case ... */
/* protect stack: xobj, clz, msg, xcl, xr + mk_class */
/* (it may confuse the UP checker since the order does vary by path, but the count is the same) */
UNPROTECT(6);
}
/* clear any pending exceptions */
HIDE void clx(JNIEnv *env) {
if (env && (*env)->ExceptionOccurred(env))
(*env)->ExceptionClear(env);
}
#ifdef JNI_CACHE
HIDE JNIEnv *getJNIEnvSafe(void);
HIDE JNIEnv *getJNIEnv(void) {
return (use_eenv)?eenv:getJNIEnvSafe();
}
HIDE JNIEnv *getJNIEnvSafe(void)
#else
HIDE JNIEnv *getJNIEnv(void)
#endif
{
JNIEnv *env;
jsize l;
jint res;
if (!jvm) { /* we're hoping that the JVM pointer won't change :P we fetch it just once */
res = JNI_GetCreatedJavaVMs(&jvm, 1, &l);
if (res != 0) {
error("JNI_GetCreatedJavaVMs failed! (result:%d)",(int)res); return 0;
}
if (l < 1)
error("No running JVM detected. Maybe .jinit() would help.");
if (!rJava_initialized)
error("rJava was called from a running JVM without .jinit().");
}
res = (*jvm)->AttachCurrentThread(jvm, (void**) &env, 0);
if (res!=0) {
error("AttachCurrentThread failed! (result:%d)", (int)res); return 0;
}
if (env && !eenv) eenv=env;
return env;
}
REP void RuseJNICache(int *flag) {
if (flag) use_eenv=*flag;
}