Esempio n. 1
0
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;
}
Esempio n. 2
0
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;
}
Esempio n. 3
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;
}
Esempio n. 4
0
File: rtest.c Progetto: csilles/cxxr
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;
}
Esempio n. 5
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;
}
Esempio n. 6
0
File: main.c Progetto: graalvm/fastr
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);
}
Esempio n. 7
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();
}
Esempio n. 8
0
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;
}
Esempio n. 9
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;
}
Esempio n. 10
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 */
}
Esempio n. 11
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 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);
}
Esempio n. 12
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);
}
Esempio n. 13
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);
}
Esempio n. 14
0
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 */
}