SEXP
R_verifyModule(SEXP r_module)
{
llvm::Module *module;
module = (GET_REF(r_module, Module)); // llvm::cast<llvm::Module>
#ifdef USE_EXCEPTIONS
try {
#endif
std::string errors;
// was PrintMessageAction
bool status;
#if LLVM_VERSION == 3 && LLVM_MINOR_VERSION < 5
status = llvm::verifyModule(*module, llvm::ReturnStatusAction, &errors);
if(status != false)
return(ScalarString(mkChar(errors.c_str())));
#else
llvm::raw_string_ostream OS(errors);
status = llvm::verifyModule(*module, &OS);
if(status == true)
return(ScalarString(mkChar(OS.str().c_str())));
#endif
#ifdef USE_EXCEPTIONS
} catch(...) {
PROBLEM "Failed in verifying the module"
ERROR;
}
#endif
return(ScalarLogical(TRUE));
}
static void
RS_XML(xmlSAX2EndElementNs)(void * ctx,
const xmlChar * localname,
const xmlChar * prefix,
const xmlChar * URI)
{
USER_OBJECT_ args, tmp, fun;
RS_XMLParserData *rinfo = (RS_XMLParserData *) ctx;
DECL_ENCODING_FROM_EVENT_PARSER(rinfo)
if(rinfo->current) {
R_endBranch(rinfo, localname, prefix, URI);
return;
}
PROTECT(args = NEW_LIST(2));
SET_VECTOR_ELT(args, 0, ScalarString(ENC_COPY_TO_USER_STRING(localname)));
PROTECT(tmp = ScalarString(ENC_COPY_TO_USER_STRING((XMLCHAR_TO_CHAR(URI)) ? XMLCHAR_TO_CHAR(URI) : "")));
if(prefix)
SET_NAMES(tmp, ScalarString(ENC_COPY_TO_USER_STRING(prefix)));
SET_VECTOR_ELT(args, 1, tmp);
fun = findEndElementFun(localname, rinfo);
if(fun) {
USER_OBJECT_ val = RS_XML(invokeFunction)(fun, args, rinfo->stateObject, rinfo->ctx);
updateState(val, rinfo);
} else
RS_XML(callUserFunction)(HANDLER_FUN_NAME(ctx, "endElement"), NULL, (RS_XMLParserData *)ctx, args);
UNPROTECT(2);
}
SEXP _as_dots_literal(SEXP list) {
assert_type(list, VECSXP);
int len = LENGTH(list);
SEXP dotlist;
if (len == 0) {
dotlist = PROTECT(allocVector(VECSXP, 0));
setAttrib(dotlist, R_ClassSymbol, ScalarString(mkChar("...")));
UNPROTECT(1);
return dotlist;
} else {
dotlist = PROTECT(allocate_dots(len));
}
SEXP names = getAttrib(list, R_NamesSymbol);
int i;
SEXP iter;
for (i = 0, iter = dotlist;
iter != R_NilValue && i < len;
i++, iter = CDR(iter)) {
assert_type(CAR(iter), PROMSXP);
SET_PRVALUE(CAR(iter), VECTOR_ELT(list, i));
SET_PRCODE(CAR(iter), VECTOR_ELT(list, i));
SET_PRENV(CAR(iter), R_NilValue);
if ((names != R_NilValue) && (STRING_ELT(names, i) != R_BlankString)) {
SET_TAG(iter, install(CHAR(STRING_ELT(names, i)) ));
}
}
setAttrib(dotlist, R_ClassSymbol, ScalarString(mkChar("...")));
UNPROTECT(1);
return dotlist;
}
SEXP
createRRoutineReference(void *fun, const char * const routineName, const char * const returnTypeName, unsigned int numParams, ...)
{
SEXP ans, klass, tmp;
va_list args;
PROTECT(klass = MAKE_CLASS("CRoutineRef"));
PROTECT(ans = NEW(klass));
SET_SLOT(ans, Rf_install("ref"), R_MakeExternalPtr(fun, Rf_install("CRoutine"), R_NilValue));
if(routineName)
SET_SLOT(ans, Rf_install("name"), ScalarString(mkChar(routineName)));
SET_SLOT(ans, Rf_install("returnType"), ScalarString(mkChar(returnTypeName)));
SET_SLOT(ans, Rf_install("numParameters"), ScalarInteger(numParams));
if(numParams > 0) {
PROTECT( tmp = NEW_CHARACTER(numParams));
va_start(args, numParams);
for(int i = 0; i < numParams; i++)
SET_STRING_ELT(tmp, i, mkChar(va_arg(args, const char * const)));
SET_SLOT(ans, Rf_install("parameterTypes"), tmp);
va_end(args);
UNPROTECT(1);
}
UNPROTECT(2);
return(ans);
}
static SEXP
convertNodeSetToR(xmlNodeSetPtr obj, SEXP fun, int encoding, SEXP manageMemory)
{
SEXP ans, expr = NULL, arg = NULL, ref;
int i;
if(!obj)
return(NULL_USER_OBJECT);
PROTECT(ans = NEW_LIST(obj->nodeNr));
if(GET_LENGTH(fun) && (TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)) {
PROTECT(expr = allocVector(LANGSXP, 2));
SETCAR(expr, fun);
arg = CDR(expr);
} else if(TYPEOF(fun) == LANGSXP) {
expr = fun;
arg = CDR(expr);
}
for(i = 0; i < obj->nodeNr; i++) {
xmlNodePtr el;
el = obj->nodeTab[i];
if(el->type == XML_ATTRIBUTE_NODE) {
#if 0
PROTECT(ref = mkString((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : ""));
SET_NAMES(ref, mkString(el->name));
#else
PROTECT(ref = ScalarString(mkCharCE((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : "", encoding)));
SET_NAMES(ref, ScalarString(mkCharCE(el->name, encoding)));
#endif
SET_CLASS(ref, mkString("XMLAttributeValue"));
UNPROTECT(1);
} else if(el->type == XML_NAMESPACE_DECL)
ref = R_createXMLNsRef((xmlNsPtr) el);
else
ref = R_createXMLNodeRef(el, manageMemory);
if(expr) {
PROTECT(ref);
SETCAR(arg, ref);
PROTECT(ref = Rf_eval(expr, R_GlobalEnv)); /*XXX do we want to catch errors here? Maybe to release the namespaces. */
SET_VECTOR_ELT(ans, i, ref);
UNPROTECT(2);
} else
SET_VECTOR_ELT(ans, i, ref);
}
if(expr) {
if(TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)
UNPROTECT(1);
} else
SET_CLASS(ans, mkString("XMLNodeSet"));
UNPROTECT(1);
return(ans);
}
SEXP
R_Value_getName(SEXP r_val)
{
llvm::Value * val = GET_REF(r_val, Value);
if(!val->hasName())
return(ScalarString(R_NaString));
llvm::StringRef str = val->getName(); // may need to use getNameStr()
return(ScalarString(mkChar(str.data())));
}
static SEXP HessAssign2(SEXP name1, SEXP name2, SEXP expr)
{
SEXP ans, newname1, newname2, tmp1, tmp2, tmp3;
PROTECT(newname1 = ScalarString(name1));
PROTECT(newname2 = ScalarString(name2));
/* this is overkill, but PR#14772 found an issue */
PROTECT(tmp1 = lang5(R_BracketSymbol, install(".hessian"), R_MissingArg,
newname1, newname2));
PROTECT(tmp2 = lang5(R_BracketSymbol, install(".hessian"), R_MissingArg,
newname2, newname1));
PROTECT(tmp3 = lang3(install("<-"), tmp2, expr));
ans = lang3(install("<-"), tmp1, tmp3);
UNPROTECT(5);
return ans;
}
/*
Convert a JSON object to an R object.
*/
SEXP
convertJSONValueToR(int type, const struct JSON_value_struct *value, cetype_t encoding)
{
SEXP ans = R_NilValue;
switch(type) {
case JSON_T_INTEGER:
ans = ScalarInteger((int) ((long) value->vu.integer_value));
break;
case JSON_T_FLOAT:
ans = ScalarReal(value->vu.float_value);
break;
case JSON_T_NULL:
ans = R_NilValue;
break;
case JSON_T_FALSE:
ans = ScalarLogical(0);
break;
case JSON_T_TRUE:
ans = ScalarLogical(1);
break;
case JSON_T_STRING:
case JSON_T_KEY:
ans = ScalarString(mkCharLenCE(value->vu.str.value, value->vu.str.length, encoding));
break;
}
return(ans);
}
static xmlEntityPtr
do_getEntityHandler(void *userData, const xmlChar *name, const char * r_funName)
{
SEXP opArgs, r_ans;
xmlEntityPtr ans = NULL;
RS_XMLParserData *parserData = (RS_XMLParserData*) userData;
DECL_ENCODING_FROM_EVENT_PARSER(parserData)
PROTECT(opArgs = NEW_LIST(1)) ;
SET_VECTOR_ELT(opArgs, 0, ScalarString(ENC_COPY_TO_USER_STRING(name))); /*XXX should we encode this? Done now! */
r_ans = RS_XML(callUserFunction)(r_funName, NULL, (RS_XMLParserData *) userData, opArgs);
PROTECT(r_ans) ;
if(r_ans != NULL_USER_OBJECT && GET_LENGTH(r_ans) > 0) {
if(TYPEOF(r_ans) == STRSXP) {
const char *value;
value = CHAR_DEREF(STRING_ELT(r_ans, 0));
ans = (xmlEntityPtr) malloc(sizeof(xmlEntity));
memset(ans, 0, sizeof(xmlEntity));
ans->type = XML_ENTITY_DECL;
ans->etype = XML_INTERNAL_GENERAL_ENTITY;
ans->name = xmlStrdup(name);
ans->orig = NULL; // xmlStrdup(CHAR_TO_XMLCHAR(value));
ans->content = xmlStrdup(CHAR_TO_XMLCHAR(value));
ans->length = strlen(value);
#ifndef NO_CHECKED_ENTITY_FIELD
ans->checked = 1;
#endif
}
}
UNPROTECT(2);
return(ans);
}
static SEXP CreateHess(SEXP names)
{
SEXP p, q, data, dim, dimnames;
int i, n;
n = length(names);
PROTECT(dimnames = lang4(R_NilValue, R_NilValue, R_NilValue, R_NilValue));
SETCAR(dimnames, install("list"));
p = install("c");
PROTECT(q = allocList(n));
SETCADDR(dimnames, LCONS(p, q));
UNPROTECT(1);
for(i = 0 ; i < n ; i++) {
SETCAR(q, ScalarString(STRING_ELT(names, i)));
q = CDR(q);
}
SETCADDDR(dimnames, duplicate(CADDR(dimnames)));
PROTECT(dim = lang4(R_NilValue, R_NilValue, R_NilValue,R_NilValue));
SETCAR(dim, install("c"));
SETCADR(dim, lang2(install("length"), install(".value")));
SETCADDR(dim, ScalarInteger(length(names)));
SETCADDDR(dim, ScalarInteger(length(names)));
PROTECT(data = ScalarReal(0.));
PROTECT(p = lang4(install("array"), data, dim, dimnames));
p = lang3(install("<-"), install(".hessian"), p);
UNPROTECT(4);
return p;
}
SEXP
R_showModule(SEXP r_module, SEXP asString)
{
llvm::Module *Mod = GET_REF(r_module, Module);
#if LLVM_VERSION == 3 && LLVM_MINOR_VERSION < 5
verifyModule(*Mod, llvm::PrintMessageAction);
#else
verifyModule(*Mod); //XXX Check
#endif
llvm::legacy::PassManager PM;
std::string str;
llvm::raw_string_ostream to(str);
#if LLVM_VERSION == 3 && LLVM_MINOR_VERSION < 5
PM.add(llvm::createPrintModulePass(&llvm::outs())); //XXX fix
#else
PM.add(llvm::createPrintModulePass(LOGICAL(asString)[0] ? to : llvm::outs())); // llvm::outs()));
#endif
PM.run(*Mod);
if(LOGICAL(asString)[0])
return(ScalarString(mkChar(str.data())));
else
return(R_NilValue);
}
SEXP
R_Module_getTargetTriple(SEXP r_module)
{
llvm::Module *mod = GET_REF(r_module, Module);
const char *str = mod->getTargetTriple().c_str();
return(str ? ScalarString(mkChar(str)) : NEW_CHARACTER(0));
}
char* Quartz_TranslateFontFamily(char* family, int face, char *devfamily) {
SEXP graphicsNS, quartzenv, fontdb, fontnames;
int i, nfonts;
char* result = devfamily;
PROTECT_INDEX xpi;
PROTECT(graphicsNS = R_FindNamespace(ScalarString(mkChar("grDevices"))));
PROTECT_WITH_INDEX(quartzenv = findVar(install(".Quartzenv"),
graphicsNS), &xpi);
if(TYPEOF(quartzenv) == PROMSXP)
REPROTECT(quartzenv = eval(quartzenv, graphicsNS), xpi);
PROTECT(fontdb = findVar(install(".Quartz.Fonts"), quartzenv));
PROTECT(fontnames = getAttrib(fontdb, R_NamesSymbol));
nfonts = LENGTH(fontdb);
if (strlen(family) > 0) {
int found = 0;
for (i=0; i<nfonts && !found; i++) {
char* fontFamily = CHAR(STRING_ELT(fontnames, i));
if (strcmp(family, fontFamily) == 0) {
found = 1;
result = SaveFontSpec(VECTOR_ELT(fontdb, i), face-1);
}
}
if (!found)
warning(_("Font family not found in Quartz font database"));
}
UNPROTECT(4);
return result;
}
static SEXP graph_makeItem(SEXP s, int i)
{
if (s == R_NilValue)
return s;
else {
SEXP item = R_NilValue;/* -Wall */
switch (TYPEOF(s)) {
case STRSXP:
item = ScalarString(STRING_ELT(s, i));
break;
case EXPRSXP:
case VECSXP:
item = duplicate(VECTOR_ELT(s, i));
break;
case LGLSXP:
item = ScalarLogical(LOGICAL(s)[i]);
break;
case INTSXP:
item = ScalarInteger(INTEGER(s)[i]);
break;
case REALSXP:
item = ScalarReal(REAL(s)[i]);
break;
case CPLXSXP:
item = ScalarComplex(COMPLEX(s)[i]);
break;
case RAWSXP:
item = ScalarRaw(RAW(s)[i]);
break;
default:
error("unknown type");
}
return item;
}
}
SEXP
R_Argument_setAttrs(llvm::Argument *arg, SEXP r_vals)
{
/* now have the parameter, so set the values. */
llvm::AttrBuilder builder;
for(unsigned i = 0 ; i < (unsigned) Rf_length(r_vals); i++)
builder.addAttribute( (AttrKind) INTEGER(r_vals)[i] );
#ifdef NEW_LLVM_ATTRIBUTES_SETUP
/* The 1 here appears to be the position/index of the argument. They start at 1 and move up.
We need to know which one it is. Same for getting the string below for the return.
Shall we determine the index in this routine or require the caller to specify it.
*/
llvm::AttributeSet attrs = llvm::AttributeSet::get(llvm::getGlobalContext(), 1/*!!!!*/, builder);
#else
llvm::Attributes attrs;
attrs = llvm::Attributes::get(llvm::getGlobalContext() , builder);
#endif
arg->addAttr(attrs);
#ifdef NEW_LLVM_ATTRIBUTES_SETUP
std::string str = attrs.getAsString(0); /*XXX WHat should the Idx argument be? */
return(str.data() ? mkString(str.data()) : R_NaString);
#else
return(ScalarString(mkChar(attrs.getAsString().data())));
#endif
}
SEXP
makeRArgument(sqlite3_value *val)
{
SEXP ans = R_NilValue;
switch(sqlite3_value_type(val)) {
case SQLITE_INTEGER: {
int iVal = sqlite3_value_int(val);
ans = ScalarInteger(iVal);
break;
}
case SQLITE_FLOAT: {
ans = ScalarReal(sqlite3_value_double(val));
break;
}
case SQLITE_TEXT:
ans = ScalarString(mkChar((char *) sqlite3_value_text(val)));
break;
default:
PROBLEM "Unhandled conversion of argument UDF from SQLite to R"
WARN;
break;
}
return(ans);
}
/**
* Init slots in S4 class git_reflog_entry
*
* @param source The source reflog entry
* @param index The entry index
* @param repo S4 class git_repository
* @param ref Reference to read from
* @param dest S4 class git_reflog_entry to initialize
* @return void
*/
void git2r_reflog_entry_init(
const git_reflog_entry *source,
size_t index,
SEXP repo,
SEXP ref,
SEXP dest)
{
SEXP i;
const char *message;
const git_signature *committer;
char sha[GIT_OID_HEXSZ + 1];
git_oid_fmt(sha, git_reflog_entry_id_new(source));
sha[GIT_OID_HEXSZ] = '\0';
SET_SLOT(dest, Rf_install("sha"), mkString(sha));
SET_SLOT(dest, Rf_install("index"), i = allocVector(INTSXP, 1));
INTEGER(i)[0] = index;
committer = git_reflog_entry_committer(source);
if (committer)
git2r_signature_init(committer, GET_SLOT(dest, Rf_install("committer")));
message = git_reflog_entry_message(source);
if (message)
SET_SLOT(dest, Rf_install("message"), mkString(message));
else
SET_SLOT(dest, Rf_install("message"), ScalarString(NA_STRING));
SET_SLOT(dest, Rf_install("refname"), ref);
SET_SLOT(dest, Rf_install("repo"), repo);
}
SEXP address(SEXP x)
{
// A better way than : http://stackoverflow.com/a/10913296/403310
char buffer[32];
snprintf(buffer, 32, "%p", (void *)x);
return(ScalarString(mkChar(buffer)));
}
SEXP
R_Module_getModuleIdentifier(SEXP r_module)
{
llvm::Module *module;
module = GET_REF(r_module, Module);
std::string str = module->getModuleIdentifier();
return( ScalarString( str.data() ? mkChar(str.data()) : R_NaString) ) ;
}
SEXP attribute_hidden do_envirName(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP env = CAR(args), ans=mkString(""), res;
checkArity(op, args);
if (TYPEOF(env) == ENVSXP ||
TYPEOF((env = simple_as_environment(env))) == ENVSXP) {
if (env == R_GlobalEnv) ans = mkString("R_GlobalEnv");
else if (env == R_BaseEnv) ans = mkString("base");
else if (env == R_EmptyEnv) ans = mkString("R_EmptyEnv");
else if (R_IsPackageEnv(env))
ans = ScalarString(STRING_ELT(R_PackageEnvName(env), 0));
else if (R_IsNamespaceEnv(env))
ans = ScalarString(STRING_ELT(R_NamespaceEnvSpec(env), 0));
else if (!isNull(res = getAttrib(env, R_NameSymbol))) ans = res;
}
return ans;
}
static SEXP DerivAssign(SEXP name, SEXP expr)
{
SEXP ans, newname;
PROTECT(ans = lang3(install("<-"), R_NilValue, expr));
PROTECT(newname = ScalarString(name));
SETCADR(ans, lang4(R_BracketSymbol, install(".grad"), R_MissingArg, newname));
UNPROTECT(2);
return ans;
}
SEXP
R_Value_print(SEXP r_value)
{
llvm::Value *val = GET_REF(r_value, Value);
std::string str;
llvm::raw_string_ostream OS(str);
val->print(OS);
return(ScalarString(mkChar( OS.str().c_str())));
}
SEXP
R_libjson_version()
{
char buf[20];
sprintf(buf, "%d.%d-%d", (int) __LIBJSON_MAJOR__,
(int) __LIBJSON_MINOR__,
(int) __LIBJSON_PATCH__);
return(ScalarString(mkChar(buf)));
}
SEXP
R_Function_getGC(SEXP r_func)
{
llvm::Function *func = GET_REF(r_func, Function);
const char *str = func->getGC();
if(str)
return(ScalarString(mkChar(str)));
else
return(NEW_CHARACTER(0));
}
SEXP
makeNodeRef(JSONNODE *node)
{
SEXP ans;
PROTECT(ans = R_MakeExternalPtr(node, Rf_install("JSONNODE"), R_NilValue));
SET_CLASS(ans, ScalarString(mkChar("JSONNODE")));
UNPROTECT(1);
return(ans);
}
static inline SEXP named_return(R_len_t ind, SEXP names) {
if (isNull(names))
return ScalarInteger(ind + 1);
SEXP res;
PROTECT(res = ScalarInteger(ind + 1));
SET_NAMES(res, ScalarString(STRING_ELT(names, ind)));
UNPROTECT(1);
return res;
}
size_t allocateDT(int8_t *typeArg, int8_t *sizeArg, int ncolArg, int ndrop, size_t allocNrow) {
// save inputs for use by pushBuffer
size = sizeArg;
type = typeArg;
int newDT = (ncol == 0);
if (newDT) {
ncol = ncolArg;
dtnrows = allocNrow;
SET_VECTOR_ELT(RCHK, 0, DT=allocVector(VECSXP,ncol-ndrop));
if (ndrop==0) {
setAttrib(DT,R_NamesSymbol,colNamesSxp); // colNames mkChar'd in userOverride step
} else {
SEXP tt = PROTECT(allocVector(STRSXP, ncol-ndrop));
setAttrib(DT, R_NamesSymbol, tt);
UNPROTECT(1); // tt; now that it's safely a member of protected object
for (int i=0,resi=0; i<ncol; i++) if (type[i]!=CT_DROP) {
SET_STRING_ELT(tt,resi++,STRING_ELT(colNamesSxp,i));
}
}
}
// TODO: move DT size calculation into a separate function (since the final size is different from the initial size anyways)
size_t DTbytes = SIZEOF(DT)*(ncol-ndrop)*2; // the VECSXP and its column names (exclude global character cache usage)
// For each column we could have one of the following cases:
// * if the DataTable is "new", then make a new vector
// * if the column's type has changed, then replace it with a new vector
// (however if column's type[i] is negative, then it means we're skipping
// the column in the rerun, and its type hasn't actually changed).
// * if dtnrows≠allocNrow and the column's type has not changed, then that
// column needs to be re-alloced (using growVector).
// * otherwise leave the column as-is.
for (int i=0, resi=0; i<ncol; i++) {
if (type[i] == CT_DROP) continue;
SEXP col = VECTOR_ELT(DT, resi);
int oldIsInt64 = newDT? 0 : INHERITS(col, char_integer64);
int newIsInt64 = type[i] == CT_INT64;
int typeChanged = (type[i] > 0) && (newDT || TYPEOF(col) != typeSxp[type[i]] || oldIsInt64 != newIsInt64);
int nrowChanged = (allocNrow != dtnrows);
if (typeChanged || nrowChanged) {
SEXP thiscol = typeChanged ? allocVector(typeSxp[type[i]], allocNrow) // no need to PROTECT, passed immediately to SET_VECTOR_ELT, see R-exts 5.9.1
: growVector(col, allocNrow);
SET_VECTOR_ELT(DT,resi,thiscol);
if (type[i]==CT_INT64) {
SEXP tt = PROTECT(ScalarString(char_integer64));
setAttrib(thiscol, R_ClassSymbol, tt);
UNPROTECT(1);
}
SET_TRUELENGTH(thiscol, allocNrow);
DTbytes += SIZEOF(thiscol)*allocNrow;
}
resi++;
}
dtnrows = allocNrow;
return DTbytes;
}
SEXP
R_statement_to_string(SEXP r_stmt, SEXP r_indent)
{
CRStatement *stmt;
gchar *ans;
stmt = R_GetStatementRef(r_stmt);
ans = cr_statement_to_string(stmt, INTEGER(r_indent)[0]);
//XXX release the string!
// free(ans);
return(ScalarString(ans ? mkChar( ans ) : NA_STRING));
}
int
R_is(SEXP val, const char * const klass)
{
SEXP expr, ans;
PROTECT(expr = allocVector(LANGSXP, 3));
SETCAR(expr, Rf_install("is"));
SETCAR(CDR(expr), val);
SETCAR(CDR(CDR(expr)), ScalarString(mkChar(klass)));
ans = Rf_eval(expr, R_GlobalEnv);
UNPROTECT(1);
return(LOGICAL(ans)[0]);
}
void
raiseError(llvm::SMDiagnostic err)
{
SEXP e, cur;
PROTECT(e = allocVector(LANGSXP, 4));
SETCAR(e, Rf_install("parseIRError")); cur = CDR(e);
SETCAR(cur, ScalarInteger(err.getLineNo())); cur = CDR(cur);
SETCAR(cur, ScalarInteger(err.getColumnNo())); cur = CDR(cur);
SETCAR(cur, ScalarString(mkChar(err.getMessage().data())));
Rf_eval(e, R_GlobalEnv);
UNPROTECT(1);
}
