rJava/src/rJava.c at master · s-u/rJava · GitHub

History

175 lines (158 loc) · 5.69 KB

Raw

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

#include <R.h>

#include <Rversion.h>

#include <Rdefines.h>

#include "rJava.h"

#include <stdlib.h>

#include <string.h>

/* 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 <no description because toString() failed>"));

}

/* 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;

}

rJava/src/rJava.c at master · s-u/rJava · GitHub

Expand file tree

Breadcrumbs

rJava.c

Latest commit

History

Breadcrumbs

rJava.c

File metadata and controls