static char *RAPIinitialize(void) {
// TODO: check for header/library version mismatch?
char *e;
// set R_HOME for packages etc. We know this from our configure script
setenv("R_HOME", RHOME, TRUE);
// set some command line arguments
{
structRstart rp;
Rstart Rp = &rp;
char *rargv[] = { "R", "--slave", "--vanilla" };
int stat = 0;
R_DefParams(Rp);
Rp->R_Slave = (Rboolean) TRUE;
Rp->R_Quiet = (Rboolean) TRUE;
Rp->R_Interactive = (Rboolean) FALSE;
Rp->R_Verbose = (Rboolean) FALSE;
Rp->LoadSiteFile = (Rboolean) FALSE;
Rp->LoadInitFile = (Rboolean) FALSE;
Rp->RestoreAction = SA_NORESTORE;
Rp->SaveAction = SA_NOSAVE;
Rp->NoRenviron = TRUE;
stat = Rf_initialize_R(2, rargv);
if (stat < 0) {
return "Rf_initialize failed";
}
R_SetParams(Rp);
}
/* disable stack checking, because threads will throw it off */
R_CStackLimit = (uintptr_t) -1;
/* redirect input/output and set error handler */
R_Outputfile = NULL;
R_Consolefile = NULL;
/* we do not want R to handle any signal, will interfere with monetdbd */
R_SignalHandlers = 0;
/* we want control R's output and input */
ptr_R_WriteConsoleEx = writeConsoleEx;
ptr_R_WriteConsole = writeConsole;
ptr_R_ReadConsole = NULL;
ptr_R_ClearerrConsole = clearRErrConsole;
// big boy here
setup_Rmainloop();
if ((e = RAPIinstalladdons()) != 0) {
return e;
}
// patch R internals to disallow quit and system. Setting them to NULL produces an error.
SET_INTERNAL(install("quit"), R_NilValue);
// install.packages() uses system2 to call gcc etc., so we cannot disable it (perhaps store the pointer somewhere just for that?)
//SET_INTERNAL(install("system"), R_NilValue);
rapiInitialized = true;
return NULL;
}
int main (int argc, char **argv)
{
structRstart rp;
Rstart Rp = &rp;
char Rversion[25], *RHome;
sprintf(Rversion, "%s.%s", R_MAJOR, R_MINOR);
if(strcmp(getDLLVersion(), Rversion) != 0) {
fprintf(stderr, "Error: R.DLL version does not match\n");
exit(1);
}
R_setStartTime();
R_DefParams(Rp);
if((RHome = get_R_HOME()) == NULL) {
fprintf(stderr,
"R_HOME must be set in the environment or Registry\n");
exit(1);
}
Rp->rhome = RHome;
Rp->home = getRUser();
Rp->CharacterMode = LinkDLL;
Rp->ReadConsole = myReadConsole;
Rp->WriteConsole = myWriteConsole;
Rp->CallBack = myCallBack;
Rp->ShowMessage = askok;
Rp->YesNoCancel = askyesnocancel;
Rp->Busy = myBusy;
Rp->R_Quiet = TRUE;
Rp->R_Interactive = FALSE;
Rp->RestoreAction = SA_RESTORE;
Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp); /* so R_ShowMessage is set */
R_SizeFromEnv(Rp);
R_SetParams(Rp);
R_set_command_line_arguments(argc, argv);
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
signal(SIGBREAK, my_onintr);
setup_term_ui(); /* initialize graphapp, eventloop, read Rconsole */
setup_Rmainloop();
#ifdef SIMPLE_CASE
run_Rmainloop();
end_Rmainloop();
#else
R_ReplDLLinit();
while(R_ReplDLLdo1() > 0) {
/* add user actions here if desired */
}
/* only get here on EOF (not q()) */
R_CleanUp(SA_DEFAULT, 0, 1);
#endif
end_Rmainloop();
return 0;
}
REmbed::REmbed(const bool verbose, const bool interactive) : verbose(verbose), interactive(interactive)
{
loaded = false;
// need to load the library
RLibrary rlib;
if (!rlib.load()) {
// disable for future
appsettings->setValue(GC_EMBED_R, false);
rlib.errors.append("\nR has now been disabled in options.");
QMessageBox msg(QMessageBox::Information,
"Failed to load R library",
rlib.errors.join("\n"));
msg.exec();
return;
}
// we need to tell embedded R where to work
QString envR_HOME(getenv("R_HOME"));
QString configR_HOME = appsettings->value(NULL,GC_R_HOME,"").toString();
if (envR_HOME == "") {
if (configR_HOME == "") {
qDebug()<<"R HOME not set, R disabled";
return;
} else {
setenv("R_HOME", configR_HOME.toLatin1().constData(), true);
}
}
// fire up R
const char *R_argv[] = {name, "--gui=none", "--no-save",
"--no-readline", "--silent", "--vanilla", "--slave"};
int R_argc = sizeof(R_argv) / sizeof(R_argv[0]);
Rf_initEmbeddedR(R_argc, (char**)R_argv);
R_ReplDLLinit(); // this is to populate the repl console buffers
structRstart Rst;
R_DefParams(&Rst);
#ifdef WIN32
Rst.rhome = getenv("R_HOME");
Rst.home = getRUser();
Rst.CharacterMode = LinkDLL;
Rst.ReadConsole = &RTool::R_ReadConsoleWin;
Rst.WriteConsole = &RTool::R_WriteConsole;
Rst.WriteConsoleEx = &RTool::R_WriteConsoleEx;
Rst.CallBack = &RTool::R_ProcessEvents;
Rst.ShowMessage = &RTool::R_ShowMessage;
Rst.YesNoCancel = &RTool::R_YesNoCancel;
Rst.Busy = &RTool::R_Busy;
#endif
Rst.R_Interactive = (Rboolean) interactive; // sets interactive() to eval to false
R_SetParams(&Rst);
loaded = true;
}
int main (int argc, char **argv)
{
structRstart rp;
Rstart Rp = &rp;
char Rversion[25], *RHome;
snprintf(Rversion, 25, "%s.%s", R_MAJOR, R_MINOR);
if(strcmp(getDLLVersion(), Rversion) != 0) {
fprintf(stderr, "Error: R.DLL version does not match\n");
exit(1);
}
R_setStartTime();
R_DefParams(Rp);
if((RHome = get_R_HOME()) == NULL) {
fprintf(stderr,
"R_HOME must be set in the environment or Registry\n");
exit(1);
}
Rp->rhome = RHome;
Rp->home = getRUser();
Rp->CharacterMode = LinkDLL;
Rp->ReadConsole = myReadConsole;
Rp->WriteConsole = NULL; /* for illustration purposes we use more flexible WriteConsoleEx */
Rp->WriteConsoleEx = myWriteConsoleEx;
Rp->CallBack = myCallBack;
Rp->ShowMessage = askok;
Rp->YesNoCancel = askyesnocancel;
Rp->Busy = myBusy;
Rp->R_Quiet = TRUE;
Rp->R_Interactive = FALSE;
Rp->RestoreAction = SA_RESTORE;
Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
R_set_command_line_arguments(argc, argv);
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
signal(SIGBREAK, my_onintr);
GA_initapp(0, 0);
readconsolecfg();
setup_Rmainloop();
#ifdef SIMPLE_CASE
run_Rmainloop();
#else
R_ReplDLLinit();
while(R_ReplDLLdo1() > 0) {
/* add user actions here if desired */
}
/* only get here on EOF (not q()) */
#endif
Rf_endEmbeddedR(0);
return 0;
}
int Rf_initialize_R(int argc, char **argv)
{
structRstart rp;
Rstart Rp = &rp;
char Rversion[25], *RHome;
snprintf(Rversion, 25, "%s.%s", R_MAJOR, R_MINOR);
if(strncmp(getDLLVersion(), Rversion, 25) != 0) {
fprintf(stderr, "Error: R.DLL version does not match\n");
exit(1);
}
R_setStartTime();
R_DefParams(Rp);
if((RHome = get_R_HOME()) == NULL) {
fprintf(stderr,
"R_HOME must be set in the environment or Registry\n");
exit(2);
}
Rp->rhome = RHome;
Rp->home = getRUser();
Rp->CharacterMode = LinkDLL;
Rp->ReadConsole = myReadConsole;
Rp->WriteConsole = myWriteConsole;
Rp->CallBack = myCallBack;
Rp->ShowMessage = askok;
Rp->YesNoCancel = askyesnocancel;
Rp->Busy = myBusy;
Rp->R_Quiet = TRUE;
Rp->R_Interactive = TRUE;
Rp->RestoreAction = SA_RESTORE;
Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
R_set_command_line_arguments(argc, argv);
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
signal(SIGBREAK, my_onintr);
GA_initapp(0, 0);
R_LoadRconsole = FALSE;
readconsolecfg();
return 0;
}
int main(int argc, char **argv) {
char *r_home = getenv("R_HOME");
if (r_home == NULL) {
printf("R_HOME must be set\n");
exit(1);
}
Rf_initialize_R(argc, argv);
structRstart rp;
Rstart Rp = &rp;
R_DefParams(Rp);
Rp->SaveAction = SA_SAVEASK;
R_SetParams(Rp);
ptr_stdR_CleanUp = ptr_R_CleanUp;
ptr_R_CleanUp = &testR_CleanUp;
ptr_stdR_Suicide = ptr_R_Suicide;
ptr_R_Suicide = &testR_Suicide;
ptr_R_ReadConsole = &testR_ReadConsole;
ptr_R_WriteConsole = &testR_WriteConsole;
DllInfo *eDllInfo = R_getEmbeddingDllInfo();
Rf_mainloop();
Rf_endEmbeddedR(0);
}
void runEmbeddedR(const core::FilePath& /*rHome*/, // ignored on posix
const core::FilePath& /*userHome*/, // ignored on posix
bool newSession,
SA_TYPE defaultSaveAction,
const Callbacks& callbacks,
InternalCallbacks* pInternal)
{
// disable R signal handlers. see src/main/main.c for the default
// implementations. in our case ignore them for the following reasons:
//
// INT - no concept of Ctrl-C based interruption (use flag directly)
//
// SEGV, ILL, & BUS: unsupported due to prompt invoking networking
// code (unsupported from within a signal handler)
//
// USR1 & USR2: same as above SEGV, etc. + we use them for other purposes
//
// PIPE: we ignore this globally in SessionMain. before doing this we
// confirmed that asio wasn't in some way manipulating it -- on linux
// boost passes MSG_NOSIGNAL to sendmsg and on OSX sets the SO_NOSIGPIPE
// option on all sockets created. note that on other platforms including
// solaris, hpux, etc. boost uses detail/signal_init to ignore SIGPIPE
// globally (this is done in io_service.hpp).
R_SignalHandlers = 0;
// set message callback early so we can see initialization error messages
ptr_R_ShowMessage = callbacks.showMessage ;
// running as main program (affects location of R_CStackStart on platforms
// without HAVE_LIBC_STACK_END or HAVE_KERN_USRSTACK). see also discussion
// on R_CStackStart in 8.1.5 Threading issues
R_running_as_main_program = 1;
// initialize R
const char *args[]= {"RStudio", "--interactive"};
Rf_initialize_R(sizeof(args)/sizeof(args[0]), (char**)args);
// For newSession = false we need to do a few things:
//
// 1) set R_Quiet so we startup without a banner
//
// 2) set LoadInitFile to supress execution of .Rprofile
//
// 3) we also need to make sure that .First is not executed. this is
// taken care of via the fact that we set RestoreAction to SA_NORESTORE
// which means that when setup_Rmainloop there is no .First function
// available to it because we haven't restored the environment yet.
// Note that .First is executed in the case of new sessions because
// it is read from .Rprofile as part of setup_Rmainloop. This implies
// that in our version of R the .First function must be defined in
// .Rprofile rather than simply saved into the global environment
// of the default workspace
//
structRstart rp;
Rstart Rp = &rp;
R_DefParams(Rp) ;
Rp->R_Slave = FALSE ;
Rp->R_Quiet = newSession ? FALSE : TRUE;
Rp->R_Interactive = TRUE ;
Rp->SaveAction = defaultSaveAction ;
Rp->RestoreAction = SA_NORESTORE; // handled within initialize()
Rp->LoadInitFile = newSession ? TRUE : FALSE;
R_SetParams(Rp) ;
// redirect console
R_Interactive = TRUE; // should have also been set by call to Rf_initialize_R
R_Consolefile = NULL;
R_Outputfile = NULL;
ptr_R_ReadConsole = callbacks.readConsole ;
ptr_R_WriteConsole = NULL; // must set this to NULL for Ex to be called
ptr_R_WriteConsoleEx = callbacks.writeConsoleEx ;
ptr_R_EditFile = callbacks.editFile ;
ptr_R_Busy = callbacks.busy;
// hook messages (in case Rf_initialize_R overwrites previously set hook)
ptr_R_ShowMessage = callbacks.showMessage ;
// hook file handling
ptr_R_ChooseFile = callbacks.chooseFile ;
ptr_R_ShowFiles = callbacks.showFiles ;
// hook history
ptr_R_loadhistory = callbacks.loadhistory;
ptr_R_savehistory = callbacks.savehistory;
ptr_R_addhistory = callbacks.addhistory;
// hook suicide, but save reference to internal suicide so we can forward
pInternal->suicide = ptr_R_Suicide;
ptr_R_Suicide = callbacks.suicide;
// hook clean up, but save reference to internal clean up so can forward
pInternal->cleanUp = ptr_R_CleanUp;
ptr_R_CleanUp = callbacks.cleanUp ;
// NOTE: we do not hook the following callbacks because they are targeted
// at clients that have a stdio-based console
// ptr_R_ResetConsole
// ptr_R_FlushConsole
// ptr_R_ClearerrConsole
// run main loop (does not return)
Rf_mainloop();
}
int initR(int argc, char **argv) {
structRstart rp;
Rstart Rp = &rp;
/* getenv("R_HOME","/Library/Frameworks/R.framework/Resources",1); */
if (!getenv("R_HOME")) {
fprintf(stderr, "R_HOME is not set. Please set all required environment variables before running this program.\n");
return -1;
}
/* this is probably unnecessary, but we could set any other parameters here */
R_DefParams(Rp);
Rp->NoRenviron = 0;
R_SetParams(Rp);
#ifdef RIF_HAS_RSIGHAND
R_SignalHandlers=0;
#endif
{
int stat=Rf_initialize_R(argc, argv);
if (stat<0) {
fprintf(stderr,"Failed to initialize embedded R! (stat=%d)\n",stat);
return -1;
}
}
#ifdef RIF_HAS_RSIGHAND
R_SignalHandlers=0;
#endif
#if (R_VERSION >= R_Version(2,3,0))
/* disable stack checking, because threads will thow it off */
R_CStackLimit = (uintptr_t) -1;
#endif
#ifdef JGR_DEBUG
fprintf(stderr,"R primary initialization done. Setting up parameters.\n");
#endif
R_Outputfile = NULL;
R_Consolefile = NULL;
R_Interactive = 1;
SaveAction = SA_SAVEASK;
/* ptr_R_Suicide = Re_Suicide; */
/* ptr_R_CleanUp = Re_CleanUp; */
ptr_R_ShowMessage = Re_ShowMessage;
ptr_R_ReadConsole = Re_ReadConsole;
#if (R_VERSION >=R_Version(2,5,0))
ptr_R_WriteConsole = NULL;
ptr_R_WriteConsoleEx = Re_WriteConsoleEx;
#else
ptr_R_WriteConsole = Re_WriteConsole;
#endif
ptr_R_ResetConsole = Re_ResetConsole;
ptr_R_FlushConsole = Re_FlushConsole;
ptr_R_ClearerrConsole = Re_ClearerrConsole;
ptr_R_Busy = Re_Busy;
ptr_R_ShowFiles = Re_ShowFiles;
ptr_R_ChooseFile = Re_ChooseFile;
ptr_R_loadhistory = Re_loadhistory;
ptr_R_savehistory = Re_savehistory;
#ifdef JGR_DEBUG
fprintf(stderr,"Setting up R event loop\n");
#endif
setup_Rmainloop();
#ifdef JGR_DEBUG
fprintf(stderr,"R initialized.\n");
#endif
return 0;
}
int initR(int argc, char **argv)
{
structRstart rp;
Rstart Rp = &rp;
char *p;
char rhb[MAX_PATH+10];
LONG h;
DWORD t,s=MAX_PATH;
HKEY k;
int cvl;
sprintf(Rversion, "%s.%s", R_MAJOR, R_MINOR);
cvl=strlen(R_MAJOR)+2;
if(strncmp(getDLLVersion(), Rversion, cvl) != 0) {
char msg[512];
sprintf(msg, "Error: R.DLL version does not match (DLL: %s, expecting: %s)\n", getDLLVersion(), Rversion);
fprintf(stderr, msg);
MessageBox(0, msg, "Version mismatch", MB_OK|MB_ICONERROR);
return -1;
}
R_DefParams(Rp);
if(getenv("R_HOME")) {
strcpy(RHome, getenv("R_HOME"));
} else { /* fetch R_HOME from the registry */
if (RegOpenKeyEx(HKEY_LOCAL_MACHINE,"SOFTWARE\\R-core\\R",0,KEY_QUERY_VALUE,&k)!=ERROR_SUCCESS ||
RegQueryValueEx(k,"InstallPath",0,&t,RHome,&s)!=ERROR_SUCCESS) {
fprintf(stderr, "R_HOME must be set or R properly installed (\\Software\\R-core\\R\\InstallPath registry entry must exist).\n");
MessageBox(0, "R_HOME must be set or R properly installed (\\Software\\R-core\\R\\InstallPath registry entry must exist).\n", "Can't find R home", MB_OK|MB_ICONERROR);
return -2;
};
sprintf(rhb,"R_HOME=%s",RHome);
putenv(rhb);
}
/* on Win32 this should set R_Home (in R_SetParams) as well */
Rp->rhome = RHome;
/*
* try R_USER then HOME then working directory
*/
if (getenv("R_USER")) {
strcpy(RUser, getenv("R_USER"));
} else if (getenv("HOME")) {
strcpy(RUser, getenv("HOME"));
} else if (getenv("HOMEDIR")) {
strcpy(RUser, getenv("HOMEDIR"));
strcat(RUser, getenv("HOMEPATH"));
} else
GetCurrentDirectory(MAX_PATH, RUser);
p = RUser + (strlen(RUser) - 1);
if (*p == '/' || *p == '\\') *p = '\0';
Rp->home = RUser;
Rp->ReadConsole = Re_ReadConsole;
#if R_VERSION >= R_Version(2,5,0)
Rp->WriteConsole = NULL;
Rp->WriteConsoleEx = Re_WriteConsoleEx;
#else
Rp->WriteConsole = Re_WriteConsole;
#endif
#if R_VERSION >= R_Version(2,1,0)
Rp->Busy = Re_Busy;
Rp->ShowMessage = Re_ShowMessage;
Rp->YesNoCancel = myYesNoCancel;
#else
Rp->busy = Re_Busy;
Rp->message = Re_ShowMessage;
Rp->yesnocancel = myYesNoCancel;
#endif
Rp->CallBack = myCallBack;
Rp->CharacterMode = LinkDLL;
Rp->R_Quiet = FALSE;
Rp->R_Interactive = TRUE;
Rp->RestoreAction = SA_RESTORE;
Rp->SaveAction = SA_SAVEASK;
#if R_VERSION < R_Version(2,0,0)
Rp->CommandLineArgs = argv;
Rp->NumCommandLineArgs = argc;
#else
R_set_command_line_arguments(argc, argv);
#endif
/* Rp->nsize = 300000;
Rp->vsize = 6e6; */
R_SetParams(Rp); /* so R_ShowMessage is set */
R_SizeFromEnv(Rp);
R_SetParams(Rp);
#if (R_VERSION >= R_Version(2,3,0))
/* R_SetParams implicitly calls R_SetWin32 which sets the
stack start/limit which we need to override */
R_CStackLimit = (uintptr_t) -1;
#endif
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
signal(SIGBREAK, my_onintr);
setup_term_ui();
setup_Rmainloop();
return 0;
}
// TODO: use a vector<string> would make all this a bit more readable
void RInside::initialize(const int argc, const char* const argv[], const bool loadRcpp,
const bool verbose, const bool interactive) {
if (instance_m) {
throw std::runtime_error( "can only have one RInside instance" ) ;
} else {
instance_m = this ;
}
verbose_m = verbose; // Default is false
interactive_m = interactive;
// generated from Makevars{.win}
#include "RInsideEnvVars.h"
#ifdef WIN32
// we need a special case for Windows where users may deploy an RInside binary from CRAN
// which will have R_HOME set at compile time to CRAN's value -- so let's try to correct
// this here: a) allow user's setting of R_HOME and b) use R's get_R_HOME() function
if (getenv("R_HOME") == NULL) { // if on Windows and not set
char *rhome = get_R_HOME(); // query it, including registry
if (rhome != NULL) { // if something was found
setenv("R_HOME", get_R_HOME(), 1); // store what we got as R_HOME
} // this will now be used in next blocks
}
#endif
for (int i = 0; R_VARS[i] != NULL; i+= 2) {
if (getenv(R_VARS[i]) == NULL) { // if env variable is not yet set
if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){
throw std::runtime_error(std::string("Could not set R environment variable ") +
std::string(R_VARS[i]) + std::string(" to ") +
std::string(R_VARS[i+1]));
}
}
}
#ifndef WIN32
R_SignalHandlers = 0; // Don't let R set up its own signal handlers
#endif
init_tempdir();
const char *R_argv[] = {(char*)programName, "--gui=none", "--no-save",
"--no-readline", "--silent", "--vanilla", "--slave"};
int R_argc = sizeof(R_argv) / sizeof(R_argv[0]);
Rf_initEmbeddedR(R_argc, (char**)R_argv);
#ifndef WIN32
R_CStackLimit = -1; // Don't do any stack checking, see R Exts, '8.1.5 Threading issues'
#endif
R_ReplDLLinit(); // this is to populate the repl console buffers
structRstart Rst;
R_DefParams(&Rst);
Rst.R_Interactive = (Rboolean) interactive_m; // sets interactive() to eval to false
#ifdef WIN32
Rst.rhome = getenv("R_HOME"); // which is set above as part of R_VARS
Rst.home = getRUser();
Rst.CharacterMode = LinkDLL;
Rst.ReadConsole = myReadConsole;
Rst.WriteConsole = myWriteConsole;
Rst.CallBack = myCallBack;
Rst.ShowMessage = myAskOk;
Rst.YesNoCancel = myAskYesNoCancel;
Rst.Busy = myBusy;
#endif
R_SetParams(&Rst);
if (true || loadRcpp) { // we always need Rcpp, so load it anyway
// Rf_install is used best by first assigning like this so that symbols get into the symbol table
// where they cannot be garbage collected; doing it on the fly does expose a minuscule risk of garbage
// collection -- with thanks to Doug Bates for the explanation and Luke Tierney for the heads-up
SEXP suppressMessagesSymbol = Rf_install("suppressMessages");
SEXP requireSymbol = Rf_install("require");
Rf_eval(Rf_lang2(suppressMessagesSymbol, Rf_lang2(requireSymbol, Rf_mkString("Rcpp"))), R_GlobalEnv);
}
global_env_m = new Rcpp::Environment(); // member variable for access to R's global environment
autoloads(); // loads all default packages, using code autogenerate from Makevars{,.win}
if ((argc - optind) > 1){ // for argv vector in Global Env */
Rcpp::CharacterVector s_argv( argv+(1+optind), argv+argc );
assign(s_argv, "argv");
} else {
assign(R_NilValue, "argv") ;
}
init_rand(); // for tempfile() to work correctly */
}
int Rf_initialize_R(int ac, char **av)
{
int i, ioff = 1, j;
Rboolean useX11 = TRUE, useTk = FALSE;
char *p, msg[1024], cmdlines[10000], **avv;
structRstart rstart;
Rstart Rp = &rstart;
Rboolean force_interactive = FALSE;
#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_GETRLIMIT)
{
struct rlimit rlim;
{
uintptr_t ii = dummy_ii();
/* 1 is downwards */
R_CStackDir = ((uintptr_t)&i > ii) ? 1 : -1;
}
if(getrlimit(RLIMIT_STACK, &rlim) == 0) {
unsigned long lim1, lim2;
lim1 = (unsigned long) rlim.rlim_cur;
lim2 = (unsigned long) rlim.rlim_max; /* Usually unlimited */
R_CStackLimit = lim1 < lim2 ? lim1 : lim2;
}
#if defined(HAVE_LIBC_STACK_END)
R_CStackStart = (uintptr_t) __libc_stack_end;
#elif defined(HAVE_KERN_USRSTACK)
{
/* Borrowed from mzscheme/gc/os_dep.c */
int nm[2] = {CTL_KERN, KERN_USRSTACK};
void * base;
size_t len = sizeof(void *);
(void) sysctl(nm, 2, &base, &len, NULL, 0);
R_CStackStart = (uintptr_t) base;
}
#else
if(R_running_as_main_program) {
/* This is not the main program, but unless embedded it is
near the top, 5540 bytes away when checked. */
R_CStackStart = (uintptr_t) &i + (6000 * R_CStackDir);
}
#endif
if(R_CStackStart == -1) R_CStackLimit = -1; /* never set */
/* printf("stack limit %ld, start %lx dir %d \n", R_CStackLimit,
R_CStackStart, R_CStackDir); */
}
#endif
ptr_R_Suicide = Rstd_Suicide;
ptr_R_ShowMessage = Rstd_ShowMessage;
ptr_R_ReadConsole = Rstd_ReadConsole;
ptr_R_WriteConsole = Rstd_WriteConsole;
ptr_R_ResetConsole = Rstd_ResetConsole;
ptr_R_FlushConsole = Rstd_FlushConsole;
ptr_R_ClearerrConsole = Rstd_ClearerrConsole;
ptr_R_Busy = Rstd_Busy;
ptr_R_CleanUp = Rstd_CleanUp;
ptr_R_ShowFiles = Rstd_ShowFiles;
ptr_R_ChooseFile = Rstd_ChooseFile;
ptr_R_loadhistory = Rstd_loadhistory;
ptr_R_savehistory = Rstd_savehistory;
ptr_R_addhistory = Rstd_addhistory;
ptr_R_EditFile = NULL; /* for future expansion */
R_timeout_handler = NULL;
R_timeout_val = 0;
R_GlobalContext = NULL; /* Make R_Suicide less messy... */
if((R_Home = R_HomeDir()) == NULL)
R_Suicide("R home directory is not defined");
BindDomain(R_Home);
process_system_Renviron();
R_setStartTime();
R_DefParams(Rp);
/* Store the command line arguments before they are processed
by the R option handler.
*/
R_set_command_line_arguments(ac, av);
cmdlines[0] = '\0';
/* first task is to select the GUI.
If run from the shell script, only Tk|tk|X11|x11 are allowed.
*/
for(i = 0, avv = av; i < ac; i++, avv++) {
if(!strncmp(*avv, "--gui", 5) || !strncmp(*avv, "-g", 2)) {
if(!strncmp(*avv, "--gui", 5) && strlen(*avv) >= 7)
p = &(*avv)[6];
else {
if(i+1 < ac) {
avv++; p = *avv; ioff++;
} else {
snprintf(msg, 1024,
_("WARNING: --gui or -g without value ignored"));
R_ShowMessage(msg);
p = "X11";
}
}
if(!strcmp(p, "none"))
useX11 = FALSE; // not allowed from R.sh
#ifdef HAVE_AQUA
else if(!strcmp(p, "aqua"))
useaqua = TRUE; // not allowed from R.sh but used by R.app
#endif
else if(!strcmp(p, "X11") || !strcmp(p, "x11"))
useX11 = TRUE;
else if(!strcmp(p, "Tk") || !strcmp(p, "tk"))
useTk = TRUE;
else {
#ifdef HAVE_X11
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using X11\n"), p);
#else
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using none\n"), p);
#endif
R_ShowMessage(msg);
}
/* now remove it/them */
for(j = i; j < ac - ioff; j++)
av[j] = av[j + ioff];
ac -= ioff;
break;
}
}
#ifdef HAVE_X11
if(useX11) R_GUIType = "X11";
#endif /* HAVE_X11 */
#ifdef HAVE_AQUA
if(useaqua) R_GUIType = "AQUA";
#endif
#ifdef HAVE_TCLTK
if(useTk) R_GUIType = "Tk";
#endif
R_common_command_line(&ac, av, Rp);
while (--ac) {
if (**++av == '-') {
if(!strcmp(*av, "--no-readline")) {
UsingReadline = FALSE;
} else if(!strcmp(*av, "-f")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strcmp(*av, "-")) {
/* Undo the escaping done in the front end */
char path[PATH_MAX], *p = path, *q;
for(q = *av; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p = '\0';
ifp = R_fopen(path, "r");
if(!ifp) {
snprintf(msg, 1024,
_("cannot open file '%s': %s"),
path, strerror(errno));
R_Suicide(msg);
}
}
} else if(!strncmp(*av, "--file=", 7)) {
Rp->R_Interactive = FALSE;
if(strcmp((*av)+7, "-")) {
/* Undo the escaping done in the front end */
char path[PATH_MAX], *p = path, *q;
for(q = (*av)+7; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p = '\0';
ifp = R_fopen(path, "r");
if(!ifp) {
snprintf(msg, 1024,
_("cannot open file '%s': %s"),
path, strerror(errno));
R_Suicide(msg);
}
}
} else if(!strcmp(*av, "-e")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strlen(cmdlines) + strlen(*av) + 2 <= 10000) {
char *p = cmdlines+strlen(cmdlines), *q;
/* Undo the escaping done in the front end */
for(q = *av; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p++ = '\n'; *p = '\0';
} else {
snprintf(msg, 1024, _("WARNING: '-e %s' omitted as input is too long\n"), *av);
R_ShowMessage(msg);
}
} else if(!strcmp(*av, "--args")) {
break;
} else if(!strcmp(*av, "--interactive")) {
force_interactive = TRUE;
break;
} else {
#ifdef HAVE_AQUA
// r27492: in 2003 launching from 'Finder OSX' passed this
if(!strncmp(*av, "-psn", 4)) break; else
#endif
snprintf(msg, 1024, _("WARNING: unknown option '%s'\n"), *av);
R_ShowMessage(msg);
}
} else {
snprintf(msg, 1024, _("ARGUMENT '%s' __ignored__\n"), *av);
R_ShowMessage(msg);
}
}
if(strlen(cmdlines)) { /* had at least one -e option */
size_t res;
if(ifp) R_Suicide(_("cannot use -e with -f or --file"));
ifp = tmpfile();
if(!ifp) R_Suicide(_("creating temporary file for '-e' failed"));
res = fwrite(cmdlines, strlen(cmdlines)+1, 1, ifp);
if(res != 1) error("fwrite error in initialize_R");
fflush(ifp);
rewind(ifp);
}
if (ifp && Rp->SaveAction != SA_SAVE) Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
if(!Rp->NoRenviron) {
process_site_Renviron();
process_user_Renviron();
}
/* On Unix the console is a file; we just use stdio to write on it */
#ifdef HAVE_AQUA
if(useaqua)
R_Interactive = useaqua;
else
#endif
R_Interactive = R_Interactive && (force_interactive || isatty(0));
#ifdef HAVE_AQUA
/* for Aqua and non-dumb terminal use callbacks instead of connections
and pretty-print warnings/errors (ESS = dumb terminal) */
if(useaqua ||
(R_Interactive && getenv("TERM") && strcmp(getenv("TERM"), "dumb"))) {
R_Outputfile = NULL;
R_Consolefile = NULL;
ptr_R_WriteConsoleEx = Rstd_WriteConsoleEx;
ptr_R_WriteConsole = NULL;
} else {
#endif
R_Outputfile = stdout;
R_Consolefile = stderr;
#ifdef HAVE_AQUA
}
#endif
/*
* Since users' expectations for save/no-save will differ, we decided
* that they should be forced to specify in the non-interactive case.
*/
if (!R_Interactive && Rp->SaveAction != SA_SAVE &&
Rp->SaveAction != SA_NOSAVE)
R_Suicide(_("you must specify '--save', '--no-save' or '--vanilla'"));
R_setupHistory();
if (R_RestoreHistory)
Rstd_read_history(R_HistoryFile);
fpu_setup(1);
return(0);
}
int Rf_initialize_R(int ac, char **av)
{
int i, ioff = 1, j;
Rboolean useX11 = TRUE, useTk = FALSE;
char *p, msg[1024], cmdlines[10000], **avv;
structRstart rstart;
Rstart Rp = &rstart;
Rboolean force_interactive = FALSE;
if (num_initialized++) {
fprintf(stderr, "%s", "R is already initialized\n");
exit(1);
}
#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_GETRLIMIT)
{
/* getrlimit is POSIX:
http://pubs.opengroup.org/onlinepubs/9699919799/functions/getrlimit.html
*/
struct rlimit rlim;
{
uintptr_t ii = dummy_ii();
/* 1 is downwards */
R_CStackDir = ((uintptr_t)&i > ii) ? 1 : -1;
}
if(getrlimit(RLIMIT_STACK, &rlim) == 0) {
/* 'unlimited' is represented by RLIM_INFINITY, which is a
very large (but maybe not the largest) representable value.
The standard allows the values RLIM_SAVED_CUR and
RLIB_SAVED_MAX, apparently used on 32-bit AIX.
(http://www.ibm.com/support/knowledgecenter/ssw_aix_61/com.ibm.aix.basetrf1/getrlimit_64.htm)
These may or may not be different from RLIM_INFINITY (they
are the same on Linux and macOS but not Solaris where they
are larger). We will assume that unrepresentable limits
are very large.
This is cautious: it is extremely unlikely that the soft
limit is either unlimited or unrepresentable.
*/
rlim_t lim = rlim.rlim_cur;
#if defined(RLIM_SAVED_CUR) && defined(RLIM_SAVED_MAX)
if (lim == RLIM_SAVED_CUR || lim == RLIM_SAVED_MAX)
lim = RLIM_INFINITY;
#endif
if (lim != RLIM_INFINITY) R_CStackLimit = (uintptr_t) lim;
}
#if defined(HAVE_LIBC_STACK_END)
{
R_CStackStart = (uintptr_t) __libc_stack_end;
/* The libc stack end is not exactly at the stack start, so one
cannot access __libc_stack_end - R_CStackLimit/getrlimit + 1. We
have to find the real stack start that matches getrlimit.
A modern alternative to __libc_stack_end and to parsing /proc/maps
directly is pthread_getattr_np; it doesn't provide the exact stack
start, either, but provides a matching stack size smaller than
the one obtained from getrlimit. However, pthread_getattr_np
may have not worked properly on old Linux distributions. */
/* based on GDB relocatable.c */
FILE *f;
f = fopen("/proc/self/maps", "r");
if (f) {
for(;;) {
int c;
unsigned long start, end;
if (fscanf(f, "%lx-%lx", &start, &end) == 2 &&
R_CStackStart >= (uintptr_t)start &&
R_CStackStart < (uintptr_t)end) {
/* would this be ok for R_CStackDir == -1? */
R_CStackStart = (uintptr_t) ((R_CStackDir == 1) ? end : start);
break;
}
for(c = getc(f); c != '\n' && c != EOF; c = getc(f));
if (c == EOF) {
/* could also abort here, but R will usually work with
R_CStackStart set just for __libc_stack_end */
fprintf(stderr, "WARNING: Error parsing /proc/self/maps!\n");
break;
}
}
fclose(f);
}
}
#elif defined(HAVE_KERN_USRSTACK)
{
/* Borrowed from mzscheme/gc/os_dep.c */
int nm[2] = {CTL_KERN, KERN_USRSTACK};
void * base;
size_t len = sizeof(void *);
(void) sysctl(nm, 2, &base, &len, NULL, 0);
R_CStackStart = (uintptr_t) base;
}
#elif defined(HAVE_THR_STKSEGMENT)
{
/* Solaris */
stack_t stack;
if (thr_stksegment(&stack))
R_Suicide("Cannot obtain stack information (thr_stksegment).");
R_CStackStart = (uintptr_t) stack.ss_sp;
/* This _may_ have to be adjusted for a (perhaps theoretical) platform
where the stack would grow upwards.
The stack size could be updated based on stack.ss_size, but experiments
suggest getrlimit is safe here. */
}
#else
if(R_running_as_main_program) {
/* This is not the main program, but unless embedded it is
near the top, 5540 bytes away when checked. */
R_CStackStart = (uintptr_t) &i + (6000 * R_CStackDir);
}
#endif
if(R_CStackStart == (uintptr_t)(-1)) R_CStackLimit = (uintptr_t)(-1); /* never set */
/* setup_Rmainloop includes (disabled) code to test stack detection */
}
#endif
ptr_R_Suicide = Rstd_Suicide;
ptr_R_ShowMessage = Rstd_ShowMessage;
ptr_R_ReadConsole = Rstd_ReadConsole;
ptr_R_WriteConsole = Rstd_WriteConsole;
ptr_R_ResetConsole = Rstd_ResetConsole;
ptr_R_FlushConsole = Rstd_FlushConsole;
ptr_R_ClearerrConsole = Rstd_ClearerrConsole;
ptr_R_Busy = Rstd_Busy;
ptr_R_CleanUp = Rstd_CleanUp;
ptr_R_ShowFiles = Rstd_ShowFiles;
ptr_R_ChooseFile = Rstd_ChooseFile;
ptr_R_loadhistory = Rstd_loadhistory;
ptr_R_savehistory = Rstd_savehistory;
ptr_R_addhistory = Rstd_addhistory;
ptr_R_EditFile = NULL; /* for future expansion */
R_timeout_handler = NULL;
R_timeout_val = 0;
R_GlobalContext = NULL; /* Make R_Suicide less messy... */
if((R_Home = R_HomeDir()) == NULL)
R_Suicide("R home directory is not defined");
BindDomain(R_Home);
process_system_Renviron();
R_setStartTime();
R_DefParams(Rp);
/* Store the command line arguments before they are processed
by the R option handler.
*/
R_set_command_line_arguments(ac, av);
cmdlines[0] = '\0';
/* first task is to select the GUI.
If run from the shell script, only Tk|tk|X11|x11 are allowed.
*/
for(i = 0, avv = av; i < ac; i++, avv++) {
if (!strcmp(*avv, "--args"))
break;
if(!strncmp(*avv, "--gui", 5) || !strncmp(*avv, "-g", 2)) {
if(!strncmp(*avv, "--gui", 5) && strlen(*avv) >= 7)
p = &(*avv)[6];
else {
if(i+1 < ac) {
avv++; p = *avv; ioff++;
} else {
snprintf(msg, 1024,
_("WARNING: --gui or -g without value ignored"));
R_ShowMessage(msg);
p = "X11";
}
}
if(!strcmp(p, "none"))
useX11 = FALSE; // not allowed from R.sh
#ifdef HAVE_AQUA
else if(!strcmp(p, "aqua"))
useaqua = TRUE; // not allowed from R.sh but used by R.app
#endif
else if(!strcmp(p, "X11") || !strcmp(p, "x11"))
useX11 = TRUE;
else if(!strcmp(p, "Tk") || !strcmp(p, "tk"))
useTk = TRUE;
else {
#ifdef HAVE_X11
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using X11\n"), p);
#else
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using none\n"), p);
#endif
R_ShowMessage(msg);
}
/* now remove it/them */
for(j = i; j < ac - ioff; j++)
av[j] = av[j + ioff];
ac -= ioff;
break;
}
}
#ifdef HAVE_X11
if(useX11) R_GUIType = "X11";
#endif /* HAVE_X11 */
#ifdef HAVE_AQUA
if(useaqua) R_GUIType = "AQUA";
#endif
#ifdef HAVE_TCLTK
if(useTk) R_GUIType = "Tk";
#endif
R_common_command_line(&ac, av, Rp);
while (--ac) {
if (**++av == '-') {
if(!strcmp(*av, "--no-readline")) {
UsingReadline = FALSE;
} else if(!strcmp(*av, "-f")) {
ac--; av++;
#define R_INIT_TREAT_F(_AV_) \
Rp->R_Interactive = FALSE; \
if(strcmp(_AV_, "-")) { \
char path[PATH_MAX], *p = path; \
p = unescape_arg(p, _AV_); \
*p = '\0'; \
ifp = R_fopen(path, "r"); \
if(!ifp) { \
snprintf(msg, 1024, \
_("cannot open file '%s': %s"), \
path, strerror(errno)); \
R_Suicide(msg); \
} \
}
R_INIT_TREAT_F(*av);
} else if(!strncmp(*av, "--file=", 7)) {
R_INIT_TREAT_F((*av)+7);
} else if(!strcmp(*av, "-e")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strlen(cmdlines) + strlen(*av) + 2 <= 10000) {
char *p = cmdlines+strlen(cmdlines);
p = unescape_arg(p, *av);
*p++ = '\n'; *p = '\0';
} else {
snprintf(msg, 1024, _("WARNING: '-e %s' omitted as input is too long\n"), *av);
R_ShowMessage(msg);
}
} else if(!strcmp(*av, "--args")) {
break;
} else if(!strcmp(*av, "--interactive")) {
force_interactive = TRUE;
break;
} else {
#ifdef HAVE_AQUA
// r27492: in 2003 launching from 'Finder OSX' passed this
if(!strncmp(*av, "-psn", 4)) break; else
#endif
snprintf(msg, 1024, _("WARNING: unknown option '%s'\n"), *av);
R_ShowMessage(msg);
}
} else {
snprintf(msg, 1024, _("ARGUMENT '%s' __ignored__\n"), *av);
R_ShowMessage(msg);
}
}
if(strlen(cmdlines)) { /* had at least one -e option */
size_t res;
if(ifp) R_Suicide(_("cannot use -e with -f or --file"));
ifp = tmpfile();
if(!ifp) R_Suicide(_("creating temporary file for '-e' failed"));
res = fwrite(cmdlines, strlen(cmdlines)+1, 1, ifp);
if(res != 1) error("fwrite error in initialize_R");
fflush(ifp);
rewind(ifp);
}
if (ifp && Rp->SaveAction != SA_SAVE) Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
if(!Rp->NoRenviron) {
process_site_Renviron();
process_user_Renviron();
/* allow for R_MAX_[VN]SIZE and R_[VN]SIZE in user/site Renviron */
R_SizeFromEnv(Rp);
R_SetParams(Rp);
}
/* On Unix the console is a file; we just use stdio to write on it */
#ifdef HAVE_AQUA
if(useaqua)
R_Interactive = useaqua;
else
#endif
R_Interactive = R_Interactive && (force_interactive || isatty(0));
#ifdef HAVE_AQUA
/* for Aqua and non-dumb terminal use callbacks instead of connections
and pretty-print warnings/errors (ESS = dumb terminal) */
if(useaqua ||
(R_Interactive && getenv("TERM") && strcmp(getenv("TERM"), "dumb"))) {
R_Outputfile = NULL;
R_Consolefile = NULL;
ptr_R_WriteConsoleEx = Rstd_WriteConsoleEx;
ptr_R_WriteConsole = NULL;
} else {
#endif
R_Outputfile = stdout;
R_Consolefile = stderr;
#ifdef HAVE_AQUA
}
#endif
/*
* Since users' expectations for save/no-save will differ, we decided
* that they should be forced to specify in the non-interactive case.
*/
if (!R_Interactive && Rp->SaveAction != SA_SAVE &&
Rp->SaveAction != SA_NOSAVE)
R_Suicide(_("you must specify '--save', '--no-save' or '--vanilla'"));
R_setupHistory();
if (R_RestoreHistory)
Rstd_read_history(R_HistoryFile);
fpu_setup(1);
return(0);
}
// TODO: use a vector<string> would make all this a bit more readable
void RInside::initialize(const int argc, const char* const argv[], const bool loadRcpp) {
logTxt("RInside::ctor BEGIN", verbose);
if (instance_) {
throw std::runtime_error( "can only have one RInside instance" ) ;
} else {
instance_ = this ;
}
verbose_m = false; // Default is false
// generated as littler.h via from svn/littler/littler.R
#include <RInsideEnvVars.h>
for (int i = 0; R_VARS[i] != NULL; i+= 2) {
if (getenv(R_VARS[i]) == NULL) { // if env variable is not yet set
if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){
//perror("ERROR: couldn't set/replace an R environment variable");
//exit(1);
throw std::runtime_error(std::string("Could not set R environment variable ") +
std::string(R_VARS[i]) + std::string(" to ") +
std::string(R_VARS[i+1]));
}
}
}
#ifndef WIN32
R_SignalHandlers = 0; // Don't let R set up its own signal handlers
#endif
#ifdef CSTACK_DEFNS
R_CStackLimit = (uintptr_t)-1; // Don't do any stack checking, see R Exts, '8.1.5 Threading issues'
#endif
init_tempdir();
const char *R_argv[] = {(char*)programName, "--gui=none", "--no-save", "--no-readline", "--silent", "", ""};
const char *R_argv_opt[] = {"--vanilla", "--slave"};
int R_argc = (sizeof(R_argv) - sizeof(R_argv_opt) ) / sizeof(R_argv[0]);
Rf_initEmbeddedR(R_argc, (char**)R_argv);
R_ReplDLLinit(); // this is to populate the repl console buffers
structRstart Rst;
R_DefParams(&Rst);
Rst.R_Interactive = (Rboolean) FALSE; // sets interactive() to eval to false
#ifdef WIN32
Rst.rhome = getenv("R_HOME"); // which is set above as part of R_VARS
Rst.home = getRUser();
Rst.CharacterMode = LinkDLL;
Rst.ReadConsole = myReadConsole;
Rst.WriteConsole = myWriteConsole;
Rst.CallBack = myCallBack;
Rst.ShowMessage = myAskOk;
Rst.YesNoCancel = myAskYesNoCancel;
Rst.Busy = myBusy;
#endif
R_SetParams(&Rst);
global_env = R_GlobalEnv ;
if (loadRcpp) { // if asked for, load Rcpp (before the autoloads)
// Rf_install is used best by first assigning like this so that symbols get into the symbol table
// where they cannot be garbage collected; doing it on the fly does expose a minuscule risk of garbage
// collection -- with thanks to Doug Bates for the explanation and Luke Tierney for the heads-up
SEXP suppressMessagesSymbol = Rf_install("suppressMessages");
SEXP requireSymbol = Rf_install("require");
Rf_eval(Rf_lang2(suppressMessagesSymbol, Rf_lang2(requireSymbol, Rf_mkString("Rcpp"))), R_GlobalEnv);
}
autoloads(); // loads all default packages
if ((argc - optind) > 1){ // for argv vector in Global Env */
Rcpp::CharacterVector s_argv( argv+(1+optind), argv+argc );
assign(s_argv, "argv");
} else {
assign(R_NilValue, "argv") ;
}
init_rand(); // for tempfile() to work correctly */
logTxt("RInside::ctor END", verbose);
}
int main(int argc, char **argv){
/* R embedded arguments, and optional arguments to be picked via cmdline switches */
char *R_argv[] = {(char*)programName, "--gui=none", "--no-restore", "--no-save", "--no-readline", "--silent", "", ""};
char *R_argv_opt[] = {"--vanilla", "--slave"};
int R_argc = (sizeof(R_argv) - sizeof(R_argv_opt) ) / sizeof(R_argv[0]);
int i, nargv, c, optpos=0, vanilla=0, quick=0, interactive=0, datastdin=0;
char *evalstr = NULL;
char *libstr = NULL;
char *libpathstr = NULL;
SEXP s_argv;
structRstart Rst;
char *datastdincmd = "X <- read.csv(file(\"stdin\"), stringsAsFactors=FALSE);";
static struct option optargs[] = {
{"help", no_argument, NULL, 'h'},
{"usage", no_argument, 0, 0},
{"version", no_argument, NULL, 'V'},
{"vanilla", no_argument, NULL, 'v'},
{"eval", required_argument, NULL, 'e'},
{"packages", required_argument, NULL, 'l'},
{"verbose", no_argument, NULL, 'p'},
{"rtemp", no_argument, NULL, 't'},
{"quick", no_argument, NULL, 'q'},
{"interactive", no_argument, NULL, 'i'},
{"datastdin", no_argument, NULL, 'd'},
{"libpath", required_argument, NULL, 'L'},
{0, 0, 0, 0}
};
while ((c = getopt_long(argc, argv, "+hVve:npl:L:tqid", optargs, &optpos)) != -1) {
switch (c) {
case 0: /* numeric 0 is code for a long option */
/* printf ("Got option %s %d", optargs[optpos].name, optpos);*/
switch (optpos) { /* so switch on the position in the optargs struct */
/* cases 0, 2, and 3 can't happen as they are covered by the '-h', */
/* '-V', and '-v' equivalences */
case 1:
showUsageAndExit();
break; /* never reached */
case 5:
verbose = 1;
break;
default:
printf("Uncovered option position '%d'. Try `%s --help' for help\n",
optpos, programName);
exit(-1);
}
break;
case 'h': /* -h is the sole short option, cf getopt_long() call */
showHelpAndExit();
break; /* never reached */
case 'e':
evalstr = optarg;
break;
case 'l':
libstr = optarg;
break;
case 'v':
vanilla=1;
break;
case 'p':
verbose=1;
break;
case 'V':
showVersionAndExit();
break; /* never reached */
case 't':
perSessionTempDir=TRUE;
break;
case 'q':
quick=1;
break;
case 'i':
interactive=1;
break;
case 'd':
datastdin=1;
break;
case 'L':
libpathstr = optarg;
break;
default:
printf("Unknown option '%c'. Try `%s --help' for help\n",(char)c, programName);
exit(-1);
}
}
if (vanilla) {
R_argv[R_argc++] = R_argv_opt[0];
}
if (!verbose) {
R_argv[R_argc++] = R_argv_opt[1];
}
#ifdef DEBUG
printf("R_argc %d sizeof(R_argv) \n", R_argc, sizeof(R_argv));
for (i=0; i<7; i++) {
printf("R_argv[%d] = %s\n", i, R_argv[i]);
}
printf("optind %d, argc %d\n", optind, argc);
for (i=0; i<argc; i++) {
printf("argv[%d] = %s\n", i, argv[i]);
}
#endif
/* Now, argv[optind] could be a file we want to source -- if we're
* in the 'shebang' case -- or it could be an expression from stdin.
* So call stat(1) on it, and if its a file we will treat it as such.
*/
struct stat sbuf;
if (optind < argc && evalstr==NULL) {
if ((strcmp(argv[optind],"-") != 0) && (stat(argv[optind],&sbuf) != 0)) {
perror(argv[optind]);
exit(1);
}
}
/* Setenv R_* env vars: insert or replace into environment. */
for (i = 0; R_VARS[i] != NULL; i+= 2){
if (setenv(R_VARS[i],R_VARS[i+1],1) != 0){
perror("ERROR: couldn't set/replace an R environment variable");
exit(1);
}
}
/* We don't require() default packages upon startup; rather, we
* set up delayedAssign's instead. see autoloads().
*/
if (setenv("R_DEFAULT_PACKAGES","NULL",1) != 0) {
perror("ERROR: couldn't set/replace R_DEFAULT_PACKAGES");
exit(1);
}
R_SignalHandlers = 0; /* Don't let R set up its own signal handlers */
#ifdef CSTACK_DEFNS
R_CStackLimit = (uintptr_t)-1; /* Don't do any stack checking, see R Exts, '8.1.5 Threading issues' */
#endif
littler_InitTempDir(); /* Set up temporary directoy */
Rf_initEmbeddedR(R_argc, R_argv); /* Initialize the embedded R interpreter */
R_ReplDLLinit(); /* this is to populate the repl console buffers */
if (!interactive) { /* new in littler 0.1.3 */
R_DefParams(&Rst);
Rst.R_Interactive = 0; /* sets interactive() to eval to false */
R_SetParams(&Rst);
}
ptr_R_CleanUp = littler_CleanUp; /* R Exts, '8.1.2 Setting R callbacks */
if (quick != 1) { /* Unless user chose not to load libraries */
autoloads(); /* Force all default package to be dynamically required */
}
/* Place any argv arguments into argv vector in Global Environment */
/* if we have an evalstr supplied from -e|--eval, correct for it */
if ((argc - optind - (evalstr==NULL)) >= 1) {
int offset = (evalstr==NULL) + (strcmp(argv[optind],"-") == 0);
/* Build string vector */
nargv = argc - optind - offset;
PROTECT(s_argv = allocVector(STRSXP,nargv));
for (i = 0; i <nargv; i++){
STRING_PTR(s_argv)[i] = mkChar(argv[i+offset+optind]);
#ifdef DEBUG
printf("Passing %s to R\n", argv[i+offset+optind]);
#endif
}
UNPROTECT(1);
setVar(install("argv"),s_argv,R_GlobalEnv);
} else {
setVar(install("argv"),R_NilValue,R_GlobalEnv);
}
init_rand(); /* for tempfile() to work correctly */
if (!vanilla) {
FILE *fp;
char rprofilesite[128];
snprintf(rprofilesite, 110, "%s/etc/Rprofile.site", getenv("R_HOME"));
if (fp = fopen(rprofilesite, "r")) {
fclose(fp); /* don't actually need it */
#ifdef DEBUG
printf("Sourcing %s\n", rprofilesite);
#endif
source(rprofilesite);
}
char dotrprofile[128];
snprintf(dotrprofile, 110, "%s/.Rprofile", getenv("HOME"));
if (fp = fopen(dotrprofile, "r")) {
fclose(fp); /* don't actually need it */
#ifdef DEBUG
printf("Sourcing %s\n", dotrprofile);
#endif
source(dotrprofile);
}
char *etclittler = "/etc/littler.r"; /* load /etc/litter.r if it exists */
if (fp = fopen(etclittler, "r")) {
fclose(fp); /* don't actually need it */
#ifdef DEBUG
printf("Sourcing %s\n", etclittler);
#endif
source(etclittler);
}
char dotlittler[128]; /* load ~/.litter.r if it exists */
snprintf(dotlittler, 110, "%s/.littler.r", getenv("HOME"));
if (fp = fopen(dotlittler, "r")) {
fclose(fp); /* don't actually need it */
#ifdef DEBUG
printf("Sourcing %s\n", dotlittler);
#endif
source(dotlittler);
}
}
if (libpathstr != NULL) { /* if requested by user, set libPaths */
char buf[128];
membuf_t pb = init_membuf(512);
snprintf(buf, 127 - 12 - strlen(libpathstr), ".libPaths(\"%s\");", libpathstr);
parse_eval(&pb, buf, 1);
destroy_membuf(pb);
}
if (libstr != NULL) { /* if requested by user, load libraries */
char *ptr, *token, *strptr;
char buf[128];
ptr = token = libstr;
membuf_t pb = init_membuf(512);
while (token != NULL) {
token = strtok_r(ptr, ",", &strptr);
ptr = NULL; /* after initial call strtok expects NULL */
if (token != NULL) {
snprintf(buf, 127 - 27 - strlen(token), "suppressMessages(library(%s));", token);
parse_eval(&pb, buf, 1);
}
}
destroy_membuf(pb);
}
if (datastdin) { /* if req. by user, read 'dat' from stdin */
membuf_t pb = init_membuf(512);
parse_eval(&pb, datastdincmd, 1);
destroy_membuf(pb);
}
/* Now determine which R code to evaluate */
int exit_val = 0;
if (evalstr != NULL) {
/* we have a command line expression to evaluate */
membuf_t pb = init_membuf(1024);
exit_val = parse_eval(&pb, evalstr, 1);
destroy_membuf(pb);
} else if (optind < argc && (strcmp(argv[optind],"-") != 0)) {
/* call R function source(filename) */
exit_val = source(argv[optind]);
} else {
/* Or read from stdin */
membuf_t lb = init_membuf(1024);
membuf_t pb = init_membuf(1024);
int lineno = 1;
while(readline_stdin(&lb)){
exit_val = parse_eval(&pb,(char*)lb->buf,lineno++);
if (exit_val) break;
}
destroy_membuf(lb);
destroy_membuf(pb);
}
littler_CleanUp(SA_NOSAVE, exit_val, 0);
return(0); /* not reached, but making -Wall happy */
}