#include
#include
#include
#include "rJava.h"
#include
#include
/* determine whether eenv chache 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;
/* -- hack to get at the current call from C code using contexts */
#if ( R_VERSION >= R_Version(1, 7, 0) )
#include
/* stuff we need to pull for Windows... */
#ifdef WIN32
/* this is from gnuwin32/fixed/h/psignal.h */
#ifndef _SIGSET_T_
#define _SIGSET_T_
typedef int sigset_t;
#endif /* Not _SIGSET_T_ */
typedef struct
{
jmp_buf jmpbuf; /* Calling environment. */
int mask_was_saved; /* Saved the signal mask? */
sigset_t saved_mask; /* Saved signal mask. */
} sigjmp_buf[1];
/* we need to set HAVE_POSIX_SETJMP since we don't have config.h on Win */
#ifndef HAVE_POSIX_SETJMP
#define HAVE_POSIX_SETJMP
#endif
#endif
#ifdef HAVE_POSIX_SETJMP
#define JMP_BUF sigjmp_buf
#else
#define JMP_BUF jmp_buf
#endif
#ifndef CTXT_BUILTIN
#define CTXT_BUILTIN 64
#endif
typedef struct RCNTXT { /* this RCNTXT structure is only partial since we need to get at "call" - it is safe form R 1.7.0 on */
struct RCNTXT *nextcontext; /* The next context up the chain <<-- we use this one to skip the .Call/.External call frame */
int callflag; /* The context "type" <<<-- we use this one to skip the .Call/.External call frame */
JMP_BUF cjmpbuf; /* C stack and register information */
int cstacktop; /* Top of the pointer protection stack */
int evaldepth; /* evaluation depth at inception */
SEXP promargs; /* Promises supplied to closure */
SEXP callfun; /* The closure called */
SEXP sysparent; /* environment the closure was called from */
SEXP call; /* The call that effected this context <<<--- we pass this one to the condition */
SEXP cloenv; /* The environment */
} RCNTXT;
#ifndef LibExtern
#define LibExtern extern
#endif
LibExtern RCNTXT* R_GlobalContext;
static SEXP getCurrentCall() {
RCNTXT *ctx = R_GlobalContext;
/* skip the .External/.Call context to get at the underlying call */
if (ctx->nextcontext && (ctx->callflag & CTXT_BUILTIN))
ctx = ctx->nextcontext;
/* skip .jcheck */
if (TYPEOF(ctx->call) == LANGSXP && CAR(ctx->call) == install(".jcheck") && ctx->nextcontext)
ctx = ctx->nextcontext;
return ctx->call;
}
#else
static SEXP getCurrentCall() {
return R_NilValue;
}
#endif
/* -- end of hack */
/** 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(2); /* clazzes, names */
eval(LCONS(install("stop"), CONS(cond, R_NilValue)), R_GlobalEnv);
UNPROTECT(1); /* cond */
}
/* 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 becasue 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 = j2SEXP(env, x, 0);
if (!rj_RJavaTools_Class) {
/* temporary warning due the JDK 12 breakage */
REprintf("WARNING: Initial Java 12 release has broken JNI support and does NOT work. Use stable Java 11 (or watch for 12u if avaiable).\nERROR: 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 = rj_RJavaTools_Class ? PROTECT( 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 = 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(MAKE_CLASS("jobjRef")));
if (inherits(xr, "jobjRef")) {
SET_SLOT(xr, install("jclass"), xclass ? xclass : mkString("java/lang/Throwable"));
SET_SLOT(xr, install("jobj"), xobj);
}
/* and off to R .. (we're keeping xr and clazzes protected) */
throwR(msg, xr, clazzes);
/* throwR never returns so don't even bother ... */
}
/* clear any pending exceptions */
HIDE void clx(JNIEnv *env) {
if (env && (*env)->ExceptionOccurred(env))
(*env)->ExceptionClear(env);
}
#ifdef JNI_CACHE
HIDE JNIEnv *getJNIEnvSafe();
HIDE JNIEnv *getJNIEnv() {
return (use_eenv)?eenv:getJNIEnvSafe();
}
HIDE JNIEnv *getJNIEnvSafe()
#else
HIDE JNIEnv *getJNIEnv()
#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;
/* if (eenv!=env)
fprintf(stderr, "Warning! eenv=%x, but env=%x - different environments encountered!\n", eenv, env); */
return env;
}
REP void RuseJNICache(int *flag) {
if (flag) use_eenv=*flag;
}