/* Initialize R, that is start an embedded R. Parameters are found in the global 'initargv'. Return 0 on success, -1 on failure. */ int EmbeddedR_init(void) { if (RINTERF_ISREADY()) { printf("R is already ready.\n"); return -1; } RStatus ^= RINTERF_IDLE; if (! RINTERF_HASARGSSET()) { /* Initialization arguments must be set and R can only be initialized once */ printf("Initialization parameters must be set first.\n"); RStatus ^= RINTERF_IDLE; return -1; } if (! initargv) { printf("No initialisation argument. This should have been caught earlier.\n"); RStatus ^= RINTERF_IDLE; return -1; } int status = Rf_initEmbeddedR(initargv->argc, initargv->argv); if (status < 0) { printf("R initialization failed.\n"); RStatus ^= RINTERF_IDLE; return -1; } /* R_Interactive = TRUE; */ /* #ifdef RIF_HAS_RSIGHAND */ /* R_SignalHandlers = 0; */ /* #endif */ /* #ifdef CSTACK_DEFNS */ /* /\* Taken from JRI: */ /* * disable stack checking, because threads will thow it off *\/ */ /* R_CStackStart = (uintptr_t) -1; */ /* R_CStackLimit = (uintptr_t) -1; */ /* /\* --- *\/ */ /* #endif */ //setup_Rmainloop(); /*FIXME: setting readline variables so R's oddly static declarations become harmless*/ // #ifdef HAS_READLINE // char *rl_completer, *rl_basic; // rl_completer = strndup(rl_completer_word_break_characters, 200); // rl_completer_word_break_characters = rl_completer; // rl_basic = strndup(rl_basic_word_break_characters, 200); // rl_basic_word_break_characters = rl_basic; // #endif /* */ errMessage_SEXP = findVar(Rf_install("geterrmessage"), R_BaseNamespace); RStatus |= (RINTERF_INITIALIZED); RStatus ^= RINTERF_IDLE; 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; }
void init_R(int argc, char **argv) { int defaultArgc = 1; char *defaultArgv[] = {(char*)"Rtest"}; if (argc == 0 || argv == NULL) { argc = defaultArgc; argv = defaultArgv; } Rf_initEmbeddedR(argc, argv); }
/* * Initialises the R interpreter. */ void init_R(int argc, char **argv){ char *defaultArgv[] = {"rsruby","--verbose"}; if (RSRUBY_R_HOME) { setenv("R_HOME", RSRUBY_R_HOME, 0); } Rf_initEmbeddedR(sizeof(defaultArgv) / sizeof(defaultArgv[0]), defaultArgv); //R_Interactive = FALSE; //Remove crash menu (and other interactive R features) }
void CRInterface::run_r_init() { #ifdef R_HOME_ENV setenv("R_HOME", R_HOME_ENV, 0); #endif char* name=strdup("R"); char* opts=strdup("-q"); char* argv[2]={name, opts}; Rf_initEmbeddedR(2, argv); free(opts); free(name); }
void RXSLT_init(xmlXPathParserContextPtr ctxt, int nargs) { const char *defaultArgs[] = {"Rxsltproc", "--silent"}; char **args; int argc, i; int mustFree; if(R_alreadyInitialized) return; #ifdef XSLT_DEBUG fprintf(stderr, "in RXSLT_init %d\n", nargs);fflush(stderr); #endif if(nargs == 0) { argc = sizeof(defaultArgs)/sizeof(defaultArgs[0]); args = (char **)defaultArgs; } else { args = (char **) malloc((nargs+1) * sizeof(char*)); args[0] = strdup("Rxsltproc"); argc = nargs+1; for(i = 0; i < nargs; i++) { xmlXPathObjectPtr obj = valuePop(ctxt); if(obj->type) { args[i+1] = strdup(xmlXPathCastToString(obj)); } } mustFree = TRUE; } Rf_initEmbeddedR(argc, args); loadXSLPackage(); valuePush(ctxt, xmlXPathNewBoolean(1)); if(mustFree) { for(i = 0; i < nargs+1; i++) { free(args[i]); } free(args); } #if DEBUG_REGISTRATION xsltRegisterExtFunction(getTransformCtxt(), "foo", R_URI, RXSLT_genericFunctionCall); RXSLT_addFunction("foo", NULL_USER_OBJECT); #endif R_alreadyInitialized = 1; return; }
int main(int argc, char *argv[]) { // Intialize the R environment. int r_argc = 2; char *r_argv[] = { "R", "--silent" }; Rf_initEmbeddedR(r_argc, r_argv); int arg[] = { 1, 2, 3, 4, 5 }; // Invoke a function in R source("func.R"); R_add1(5, arg); // Release R environment Rf_endEmbeddedR(0); return(0); }
int rffi_init(char* arg) //(int argc,char* argv[]) { if(!rffi_initialized) { char* argv[4]; argv[0]="REmbed"; argv[1]="--save"; argv[2]="--slave"; argv[3]="--quiet"; printf("arg=%s\n",arg); R_CStackStart = (uintptr_t)-1; Rf_initEmbeddedR(4,argv); R_Interactive = FALSE; printf("rffi init\n"); rffi_initialized=1; return 1; } else return 0; }
/* {{{ proto void R::init([array argv]) */ static PHP_METHOD(R, init) { zval *argv = NULL; int argc = 3; HashPosition pos; char **argv_arr; zval **element; int i; char *r_home; if (zend_parse_parameters(ZEND_NUM_ARGS() TSRMLS_CC, "|a", &argv) == FAILURE) { return; } r_home = getenv("R_HOME"); if (!r_home || r_home[0] == '\0') { setenv("R_HOME", PHP_R_DIR, 0); } R_SetErrorHook(php_r_error_handler); R_SetWarningHook(php_r_warning_handler); if (argv) { argc += zend_hash_num_elements(Z_ARRVAL_P(argv)); } argv_arr = safe_emalloc(argc, sizeof(char *), 0); argv_arr[0] = "REmbeddedPHP"; argv_arr[1] = "--gui=none"; argv_arr[2] = "--silent"; if (argv) { i = 3; for (zend_hash_internal_pointer_reset_ex(Z_ARRVAL_P(argv), &pos); zend_hash_get_current_data_ex(Z_ARRVAL_P(argv), (void **) &element, &pos) == SUCCESS; zend_hash_move_forward_ex(Z_ARRVAL_P(argv), &pos) ) { convert_to_string_ex(element); argv_arr[i] = Z_STRVAL_PP(element); /* no copy here, libR does strdup() itself */ i++; } } Rf_initEmbeddedR(argc, argv_arr); efree(argv_arr); }
/** Initialises the R interpreter in the libR.so library. * * @param argv An OCaml array of strings, which gives the command * line arguments used to invoke the R interpreter. Code * segfaults if the array does not contain a first element, * which is the name of the program, typically "R", or * "OCaml-R". Other arguments typically are "--vanilla", * "--slave"... * @param sigs An OCaml integer. When set to 0, R signal handlers * are not removed. When set, for example, to 1, R signal * handlers are removed. It is very useful to remove signal * handlers when embedding R. Requires R >= 2.3.1. * @return 1 if R is correctly initialised. */ CAMLprim value ocamlr_initEmbeddedR (value ml_argv, value ml_sigs) { int length = Wosize_val(ml_argv); char* argv[length]; int i; // We duplicate the OCaml array into a C array. for (i=0; i<length; i++) argv[i]=String_val(Field(ml_argv, i)); /* Don't let R set up its own signal handlers when sigs = 1. This requires R >= 2.3.1. */ if (Int_val(ml_sigs)) R_SignalHandlers = 0; // This is the libR.so function. i = Rf_initEmbeddedR(length, argv); // Returns 1 if R is correctly initialised. return Val_int(i); }
int inla_R_init(void) { if (R_init == !INLA_OK) { #pragma omp critical { if (R_init == !INLA_OK) { char *Rargv[] = {"REmbeddedPostgres", "--gui=none", "--silent", "--no-init-file"}; int Rargc = sizeof(Rargv)/sizeof(Rargv[0]); Rf_initEmbeddedR(Rargc, Rargv); atexit(inla_R_exit); /* cleanup at exit */ R_init = INLA_OK; if (R_debug) fprintf(stderr, "R-interface: init\n"); } } } return INLA_OK; }
int rcall_init() { if (R_is_initialized == 1) { jl_error("R is running."); return -1; } char *argv[] = {"RCall", "--slave"}; int argc = sizeof(argv)/sizeof(argv[0]); int ret = Rf_initEmbeddedR(argc, argv); if (ret < 0) { jl_error("R initialization failed."); return -1; } rcall_register_routines(); R_is_ready = 1; R_is_initialized = 1; return ret; }
/** Initialize the plugin when it is loaded by Gnumeric. */ void plugin_init_general(ErrorInfo **ret_error) { extern int Rf_initEmbeddedR(int argc, char *argv[]); char *argv[] = {"Rgnumeric", "--silent"}; const char *profile; char buf[1000]; *ret_error = NULL; Rf_initEmbeddedR(sizeof(argv)/sizeof(argv[0]), argv); /* Now, ensure the Gnumeric library is loaded. */ if(loadGnumericLibrary() == FALSE) { *ret_error = error_info_new_printf("Failed to load RGnumeric library into R. Something's wrong"); return; } /* Read the different R gnumeric startup scripts ~/.gnumeric/plugins/R/Rprofile ~/.gnumeric/<version-number>/plugins/R/Rprofile value of R_GNUMERIC_PROFILE */ sprintf(buf, "%s/.gnumeric/Rprofile", getenv("HOME")); RGnumeric_loadProfile(buf); sprintf(buf, "%s/.gnumeric/%s/plugins/R/Rprofile", getenv("HOME"), GNUMERIC_VERSION_STRING); RGnumeric_loadProfile(buf); if((profile=getenv("R_GNUMERIC_PROFILE")) != NULL) { RGnumeric_loadProfile(profile); } }
// 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 */ }
void initR() { char *argv[] = {"RdeR", "--quiet", "--vanilla"}; int argc = sizeof(argv) / sizeof(argv[0]); Rf_initEmbeddedR(argc, argv); }
int main(int argc, char **argv) { int i; xsltStylesheetPtr cur = NULL; xmlDocPtr doc, style; if (argc <= 1) { usage(argv[0]); return (1); } xmlInitMemory(); LIBXML_TEST_VERSION defaultLoader = xmlGetExternalEntityLoader(); xmlLineNumbersDefault(1); if (novalid == 0) /* TODO XML_DETECT_IDS | XML_COMPLETE_ATTRS */ xmlLoadExtDtdDefaultValue = 6; else xmlLoadExtDtdDefaultValue = 0; for (i = 1; i < argc; i++) { if (!strcmp(argv[i], "-")) break; if (argv[i][0] != '-') continue; #ifdef LIBXML_DEBUG_ENABLED if ((!strcmp(argv[i], "-debug")) || (!strcmp(argv[i], "--debug"))) { debug++; } else #endif if ((!strcmp(argv[i], "-v")) || (!strcmp(argv[i], "-verbose")) || (!strcmp(argv[i], "--verbose"))) { xsltSetGenericDebugFunc(stderr, NULL); } else if ((!strcmp(argv[i], "-o")) || (!strcmp(argv[i], "-output")) || (!strcmp(argv[i], "--output"))) { i++; output = argv[i++]; } else if ((!strcmp(argv[i], "-V")) || (!strcmp(argv[i], "-version")) || (!strcmp(argv[i], "--version"))) { printf("Using libxml %s, libxslt %s and libexslt %s\n", xmlParserVersion, xsltEngineVersion, exsltLibraryVersion); printf ("xsltproc was compiled against libxml %d, libxslt %d and libexslt %d\n", LIBXML_VERSION, LIBXSLT_VERSION, LIBEXSLT_VERSION); printf("libxslt %d was compiled against libxml %d\n", xsltLibxsltVersion, xsltLibxmlVersion); printf("libexslt %d was compiled against libxml %d\n", exsltLibexsltVersion, exsltLibxmlVersion); } else if ((!strcmp(argv[i], "-repeat")) || (!strcmp(argv[i], "--repeat"))) { if (repeat == 0) repeat = 20; else repeat = 100; } else if ((!strcmp(argv[i], "-novalid")) || (!strcmp(argv[i], "--novalid"))) { novalid++; } else if ((!strcmp(argv[i], "-noout")) || (!strcmp(argv[i], "--noout"))) { noout++; #ifdef LIBXML_DOCB_ENABLED } else if ((!strcmp(argv[i], "-docbook")) || (!strcmp(argv[i], "--docbook"))) { docbook++; #endif #ifdef LIBXML_HTML_ENABLED } else if ((!strcmp(argv[i], "-html")) || (!strcmp(argv[i], "--html"))) { html++; #endif } else if ((!strcmp(argv[i], "-timing")) || (!strcmp(argv[i], "--timing"))) { timing++; } else if ((!strcmp(argv[i], "-profile")) || (!strcmp(argv[i], "--profile"))) { profile++; } else if ((!strcmp(argv[i], "-norman")) || (!strcmp(argv[i], "--norman"))) { profile++; } else if ((!strcmp(argv[i], "-warnnet")) || (!strcmp(argv[i], "--warnnet"))) { xmlSetExternalEntityLoader(xsltNoNetExternalEntityLoader); } else if ((!strcmp(argv[i], "-nonet")) || (!strcmp(argv[i], "--nonet"))) { xmlSetExternalEntityLoader(xsltNoNetExternalEntityLoader); nonet = 1; #ifdef LIBXML_CATALOG_ENABLED } else if ((!strcmp(argv[i], "-catalogs")) || (!strcmp(argv[i], "--catalogs"))) { const char *catalogs; catalogs = getenv("SGML_CATALOG_FILES"); if (catalogs == NULL) { fprintf(stderr, "Variable $SGML_CATALOG_FILES not set\n"); } else { xmlLoadCatalogs(catalogs); } #endif #ifdef LIBXML_XINCLUDE_ENABLED } else if ((!strcmp(argv[i], "-xinclude")) || (!strcmp(argv[i], "--xinclude"))) { xinclude++; xsltSetXIncludeDefault(1); #endif } else if ((!strcmp(argv[i], "-param")) || (!strcmp(argv[i], "--param"))) { i++; params[nbparams++] = argv[i++]; params[nbparams++] = argv[i]; if (nbparams >= 16) { fprintf(stderr, "too many params\n"); return (1); } } else if ((!strcmp(argv[i], "-maxdepth")) || (!strcmp(argv[i], "--maxdepth"))) { int value; i++; if (sscanf(argv[i], "%d", &value) == 1) { if (value > 0) xsltMaxDepth = value; } } else if (!strcmp(argv[i], "--r")) { startRAutomatically = 1; RstartupScript = strchr(argv[i],'='); continue; } else { fprintf(stderr, "Unknown option %s\n", argv[i]); usage(argv[0]); return (1); } } params[nbparams] = NULL; /* * Replace entities with their content. */ xmlSubstituteEntitiesDefault(1); /* * Register the EXSLT extensions */ exsltRegisterAll(); registerRModule(0); if(startRAutomatically) { extern int RXSLT_internalSource(const char *fileName); int rargs = 1; const char *rargv[] = { "Sxsltproc" }; Rf_initEmbeddedR(rargs, rargv); loadXSLPackage(); if(RstartupScript && RstartupScript[0]) RXSLT_internalSource(RstartupScript); } for (i = 1; i < argc; i++) { if ((!strcmp(argv[i], "-maxdepth")) || (!strcmp(argv[i], "--maxdepth"))) { i++; continue; } else if ((!strcmp(argv[i], "-o")) || (!strcmp(argv[i], "-output")) || (!strcmp(argv[i], "--output"))) { i++; continue; } if ((!strcmp(argv[i], "-param")) || (!strcmp(argv[i], "--param"))) { i += 2; continue; } else if(!strcmp(argv[i], "--r")) { continue; } if ((argv[i][0] != '-') || (strcmp(argv[i], "-") == 0)) { if (timing) gettimeofday(&begin, NULL); style = xmlParseFile((const char *) argv[i]); if (timing) { long msec; gettimeofday(&end, NULL); msec = end.tv_sec - begin.tv_sec; msec *= 1000; msec += (end.tv_usec - begin.tv_usec) / 1000; fprintf(stderr, "Parsing stylesheet %s took %ld ms\n", argv[i], msec); } if (style == NULL) { fprintf(stderr, "cannot parse %s\n", argv[i]); cur = NULL; } else { cur = xsltLoadStylesheetPI(style); if (cur != NULL) { /* it is an embedded stylesheet */ xsltProcess(style, cur, argv[i]); xsltFreeStylesheet(cur); exit(0); } cur = xsltParseStylesheetDoc(style); if (cur != NULL) { if (cur->indent == 1) xmlIndentTreeOutput = 1; else xmlIndentTreeOutput = 0; i++; } } break; } } /* * disable CDATA from being built in the document tree */ xmlDefaultSAXHandlerInit(); xmlDefaultSAXHandler.cdataBlock = NULL; if ((cur != NULL) && (cur->errors == 0)) { for (; i < argc; i++) { doc = NULL; if (timing) gettimeofday(&begin, NULL); #ifdef LIBXML_HTML_ENABLED if (html) doc = htmlParseFile(argv[i], NULL); else #endif #ifdef LIBXML_DOCB_ENABLED if (docbook) doc = docbParseFile(argv[i], NULL); else #endif doc = xmlParseFile(argv[i]); if (doc == NULL) { fprintf(stderr, "unable to parse %s\n", argv[i]); continue; } if (timing) { long msec; gettimeofday(&end, NULL); msec = end.tv_sec - begin.tv_sec; msec *= 1000; msec += (end.tv_usec - begin.tv_usec) / 1000; fprintf(stderr, "Parsing document %s took %ld ms\n", argv[i], msec); } xsltProcess(doc, cur, argv[i]); } xsltFreeStylesheet(cur); } #ifdef CAN_UNREGISTER_MODULES xsltUnregisterAllExtModules(); #endif xmlCleanupParser(); xmlMemoryDump(); 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[]){ // Housekeeping inputs int warnings = 0; // Display warnings int recover = 0; // Recover from previous simulation int ir = 0; int i = 0; int j = 0; int im = 0; int nmoons_max = 100; // Grid inputs double timestep = 0.0; // Time step of the sim (yr) double speedup = 0.0; // Speedup factor of the thermal evolution sim (if thermal-orbital sim taks too much time) int NR = 0; // Number of grid zones double total_time = 0.0; // Total time of sim double output_every = 0.0; // Output frequency int NT_output = 0; // Time step for writing output // Planet inputs double Mprim = 0.0; // Mass of the primary (host planet) (kg) double Rprim = 0.0; // Radius of the primary (host planet) (km) double Qprimi = 0.0; // Initial tidal Q of the primary (host planet) double Qprimf = 0.0; // Final tidal Q of the primary int Qmode = 0; // How Q changes over time between Qprimi and Qprimf. 0:linearly; 1:exponential decay; 2:exponential change double k2prim = 0.0; // k2 tidal Love number of primary (Saturn: 0.39, Lainey et al. 2017?, 1.5 for homogeneous body) double J2prim = 0.0; // 2nd zonal harmonic of gravity field (Saturn: 16290.71±0.27e-6, Jacobson et al., 2006) double J4prim = 0.0; // 4th zonal harmonic of gravity field (-935.83±2.77e-6, Jacobson et al., 2006) int nmoons = 0; // User-specified number of moons double Mring = 0.0; // Mass of planet rings (kg). For Saturn, 4 to 7e19 kg (Robbins et al. 2010, http://dx.doi.org/10.1016/j.icarus.2009.09.012) double aring_in = 0.0; // Inner orbital radius of rings (km). for Saturn B ring, 92000 km double aring_out = 0.0; // Outer orbital radius of rings (km). for Saturn's A ring, 140000 km // Tidal model inputs int tidalmodel = 0; // 1: Elastic model; 2: Maxwell model; 3: Burgers model; 4: Andrade model double tidetimes = 0.0; // Multiply tidal dissipation by this factor, realistically up to 10 (McCarthy & Cooper 2016) // Geophysical inputs double rhoHydrRock = 0.0; // Density of hydrated rock endmember (kg m-3) double rhoDryRock = 0.0; // Density of dry rock endmember (kg m-3) int chondr = 0; // Nature of the chondritic material incorporated (3/30/2015: default=CI or 1=CO), matters // for radiogenic heating, see Thermal-state() // Icy world inputs double r_p[nmoons_max]; // Planetary radius double rho_p[nmoons_max]; // Planetary density (g cm-3) double Tsurf[nmoons_max]; // Surface temperature double Tinit[nmoons_max]; // Initial temperature double tzero[nmoons_max]; // Time of formation (Myr) double nh3[nmoons_max]; // Ammonia w.r.t. water double salt[nmoons_max]; // Salt w.r.t. water (3/30/2015: binary quantity) double Xhydr_init[nmoons_max]; // Initial degree of hydration of the rock (0=fully dry, 1=fully hydrated) int hy[nmoons_max]; // Allow for rock hydration/dehydration? double Xfines[nmoons_max]; // Mass or volume fraction of rock in fine grains that don't settle into a core (0=none, 1=all) double Xpores[nmoons_max]; // Mass of volume fraction of core occupied by ice and/or liquid (i.e., core porosity filled with ice and/or liquid) double porosity[nmoons_max]; // Bulk porosity int startdiff[nmoons_max]; // Start differentiated? int orbevol[nmoons_max]; // Orbital evolution? double aorb[nmoons_max]; // Moon orbital semi-major axis (km) double eorb[nmoons_max]; // Moon orbital eccentricity for (im=0;im<nmoons_max;im++) { tzero[im] = 0.0; r_p[im] = 0.0; rho_p[im] = 0.0; Tsurf[im] = 0.0; Tinit[im] = 0.0; nh3[im] = 0.0; salt[im] = 0.0; Xhydr_init[im] = 0.0; Xfines[im] = 0.0; Xpores[im] = 0.0; hy[im] = 0.0; porosity[im] = 0.0; startdiff[im] = 0.0; orbevol[im] = 0.0; aorb[im] = 0.0; eorb[im] = 0.0; } // Call specific subroutines int run_thermal = 0; // Run thermal code int run_aTP = 0; // Generate a table of flaw size that maximize stress (Vance et al. 2007) int run_alpha_beta = 0; // Calculate thermal expansivity and compressibility tables int run_crack_species = 0; // Calculate equilibrium constants of species that dissolve or precipitate int run_geochem = 0; // Run the PHREEQC code for the specified ranges of parameters int run_compression = 0; // Re-calculate last internal structure of Thermal() output by taking into account the effects of compression int run_cryolava = 0; // Calculate gas-driven exsolution // Crack subroutine inputs int *crack_input = (int*) malloc(5*sizeof(int)); int *crack_species = (int*) malloc(4*sizeof(int)); // Geochemistry subroutine inputs double Tmax = 0.0; double Tmin = 0.0; double Tstep = 0.0; double Pmax = 0.0; double Pmin = 0.0; double Pstep = 0.0; double pemax = 0.0; double pemin = 0.0; double pestep = 0.0; double WRmax = 0.0; // Max water:rock ratio by mass double WRmin = 0.0; // Min water:rock ratio by mass double WRstep = 0.0; // Step (multiplicative) in water:rock ratio // Cryolava subroutine inputs int t_cryolava = 0; // Time at which to calculate gas exsolution double CHNOSZ_T_MIN = 0.0; // Minimum temperature for the subcrt() routine of CHNOSZ to work // Default: 235 K (Cryolava), 245 K (Crack, P>200 bar) int n_inputs = 200; double *input = (double*) malloc(n_inputs*sizeof(double)); if (input == NULL) printf("IcyDwarf: Not enough memory to create input[%d]\n", n_inputs); for (i=0;i<n_inputs;i++) input[i] = 0.0; //------------------------------------------------------------------- // Startup //------------------------------------------------------------------- printf("\n"); printf("-------------------------------------------------------------------\n"); printf("IcyDwarf v18.6\n"); if (v_release == 1) printf("Release mode\n"); else if (cmdline == 1) printf("Command line mode\n"); printf("-------------------------------------------------------------------\n"); // Initialize the R environment. We do it here, in the main loop, because this can be done only once. // Otherwise, the program crashes at the second initialization. setenv("R_HOME","/Library/Frameworks/R.framework/Resources",1); // Specify R home directory Rf_initEmbeddedR(argc, argv); // Launch R CHNOSZ_init(1); // Launch CHNOSZ // Get current directory. Works for Mac only! To switch between platforms, see: // http://stackoverflow.com/questions/1023306/finding-current-executables-path-without-proc-self-exe char path[1024]; unsigned int size = sizeof(path); path[0] = '\0'; if (_NSGetExecutablePath(path, &size) == 0) printf("\n"); else printf("IcyDwarf: Couldn't retrieve executable directory. Buffer too small; need size %u\n", size); //------------------------------------------------------------------- // Read input //------------------------------------------------------------------- input = icy_dwarf_input (input, path); i = 0; //----------------------------- warnings = (int) input[i]; i++; recover = (int) input[i]; i++; //----------------------------- NR = input[i]; i++; timestep = input[i]; i++; // yr speedup = input[i]; i++; total_time = input[i]; i++; // Myr output_every = input[i]; i++; // Myr //----------------------------- Mprim = input[i]; i++; // kg Rprim = input[i]; i++; // km Qprimi = input[i]; i++; Qprimf = input[i]; i++; Qmode = (int) input[i]; i++; k2prim = input[i]; i++; J2prim = input[i]; i++; J4prim = input[i]; i++; nmoons = (int) input[i]; i++; Mring = input[i]; i++; // kg aring_in = input[i]; i++; // cm aring_out = input[i]; i++; // cm //----------------------------- for (im=0;im<nmoons;im++) r_p[im] = input[i+im]; // km i=i+nmoons; for (im=0;im<nmoons;im++) rho_p[im] = input[i+im]; // g cm-3 i=i+nmoons; for (im=0;im<nmoons;im++) Tsurf[im] = input[i+im]; // K i=i+nmoons; for (im=0;im<nmoons;im++) Tinit[im] = input[i+im]; // K i=i+nmoons; for (im=0;im<nmoons;im++) tzero[im] = input[i+im]; // Myr i=i+nmoons; for (im=0;im<nmoons;im++) nh3[im] = input[i+im]; // Fraction w.r.t. H2O i=i+nmoons; for (im=0;im<nmoons;im++) salt[im] = input[i+im]; // 0 or 1 i=i+nmoons; for (im=0;im<nmoons;im++) Xhydr_init[im] = input[i+im]; i=i+nmoons; for (im=0;im<nmoons;im++) hy[im] = input[i+im]; i=i+nmoons; for (im=0;im<nmoons;im++) porosity[im] = input[i+im]; // vol fraction i=i+nmoons; for (im=0;im<nmoons;im++) Xfines[im] = input[i+im]; // mass fraction = vol fraction i=i+nmoons; for (im=0;im<nmoons;im++) Xpores[im] = input[i+im]; // vol fraction i=i+nmoons; for (im=0;im<nmoons;im++) startdiff[im] = (int) input[i+im]; i=i+nmoons; for (im=0;im<nmoons;im++) aorb[im] = input[i+im]; // km i=i+nmoons; for (im=0;im<nmoons;im++) eorb[im] = input[i+im]; i=i+nmoons; for (im=0;im<nmoons;im++) orbevol[im] = (int) input[i+im]; i=i+nmoons; //----------------------------- rhoDryRock = input[i]; i++; // g cm-3 rhoHydrRock = input[i]; i++; // g cm-3 chondr = (int) input[i]; i++; tidalmodel = (int) input[i]; i++; tidetimes = input[i]; i++; //----------------------------- run_thermal = (int) input[i]; i++; run_aTP = (int) input[i]; i++; run_alpha_beta = (int) input[i]; i++; run_crack_species = (int) input[i]; i++; run_geochem = (int) input[i]; i++; Tmin = input[i]; i++; Tmax = input[i]; i++; Tstep = input[i]; i++; Pmin = input[i]; i++; Pmax = input[i]; i++; Pstep = input[i]; i++; pemin = input[i]; i++; pemax = input[i]; i++; pestep = input[i]; i++; WRmin = input[i]; i++; WRmax = input[i]; i++; WRstep = input[i]; i++; run_compression = (int) input[i]; i++; run_cryolava = (int) input[i]; i++; t_cryolava = (int) input[i]/output_every; i++; // Myr CHNOSZ_T_MIN = input[i]; i++; // K //----------------------------- for (j=0;j<4;j++) { crack_input[j] = (int) input[i]; i++; } for (j=0;j<4;j++) { crack_species[j] = (int) input[i]; i++; } if (nmoons > nmoons_max) { printf("Too many moons for the code to handle. Increase nmoon_max in the source code\n"); exit(0); } //------------------------------------------------------------------- // Print input //------------------------------------------------------------------- printf("1 for Yes, 0 for No\n"); printf("--------------------------------------------------------------------------------------------------------\n"); printf("| Housekeeping |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||\n"); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Warnings? | %d\n", warnings); printf("| Recover? | %d\n", recover); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Grid |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||\n"); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Number of grid zones | %d\n", NR); printf("| Thermal-orbital simulation time step (yr) | %g\n", timestep); printf("| Thermal simulation speedup factor | %g\n", speedup); printf("| Total time of thermal simulation (Myr) | %g\n", total_time); printf("| Output every (Myr) | %g\n", output_every); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Host planet parameters |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||\n"); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Mass (kg) (0 if world is not a moon) | %g\n", Mprim); printf("| Radius (km) | %g\n", Rprim); printf("| Tidal Q (initial,today,{0:lin 1:exp 2:1-exp}) | %g %g %d\n", Qprimi, Qprimf, Qmode); printf("| Love number k2; zonal gravity harmonics J2, J4| %g %g %g\n", k2prim, J2prim, J4prim); printf("| Number of moons | %d\n", nmoons); printf("| Ring mass (kg) (0 if no rings) | %g\n", Mring); printf("| Ring inner edge (km) | %g\n", aring_in); printf("| Ring outer edge (km) | %g\n", aring_out); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Icy world parameters |||||||||||||||||||||||||| World 1 | World 2 | World 3 | World 4 | World 5 |\n"); printf("|-----------------------------------------------|----------|----------|----------|----------|----------|\n"); printf("| Radius assuming zero porosity (km) |"); for (im=0;im<nmoons;im++) printf(" %g \t", r_p[im]); printf("\n| Density assuming zero porosity (g cm-3) |"); for (im=0;im<nmoons;im++) printf(" %g \t", rho_p[im]); printf("\n| Surface temperature (K) |"); for (im=0;im<nmoons;im++) printf(" %g \t", Tsurf[im]); printf("\n| Initial temperature (K) |"); for (im=0;im<nmoons;im++) printf(" %g \t", Tinit[im]); printf("\n| Time of formation (Myr) |"); for (im=0;im<nmoons;im++) printf(" %g \t", tzero[im]); printf("\n| Ammonia w.r.t. water |"); for (im=0;im<nmoons;im++) printf(" %g \t", nh3[im]); printf("\n| Briny liquid? y=1, n=0 |"); for (im=0;im<nmoons;im++) printf(" %g \t", salt[im]); printf("\n| Initial degree of hydration |"); for (im=0;im<nmoons;im++) printf(" %g \t", Xhydr_init[im]); printf("\n| Hydrate/dehydrate? |"); for (im=0;im<nmoons;im++) printf(" %d \t", hy[im]); printf("\n| Initial porosity volume fraction |"); for (im=0;im<nmoons;im++) printf(" %g \t", porosity[im]); printf("\n| Fraction of rock in fines |"); for (im=0;im<nmoons;im++) printf(" %g \t", Xfines[im]); printf("\n| Core ice/liquid water volume fraction |"); for (im=0;im<nmoons;im++) printf(" %g \t", Xpores[im]); printf("\n| Start differentiated? |"); for (im=0;im<nmoons;im++) printf(" %d \t", startdiff[im]); printf("\n| Initial orbital semi-major axis (km) |"); for (im=0;im<nmoons;im++) printf(" %g ", aorb[im]); printf("\n| Initial orbital eccentricity |"); for (im=0;im<nmoons;im++) printf(" %g \t", eorb[im]); printf("\n| Allow orbit to change? |"); for (im=0;im<nmoons;im++) printf(" %d \t", orbevol[im]); printf("\n|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Dry rock density (g cm-3) | %g\n", rhoDryRock); printf("| Hydrated rock density (g cm-3) | %g\n", rhoHydrRock); printf("| Chondrite type? CI=0 CO=1 | %d\n", chondr); printf("| Tidal rheology? Maxwell=2 Burgers=3 Andrade=4 | %d\n", tidalmodel); printf("| Tidal heating x... | %g\n", tidetimes); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Subroutines ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||\n"); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Run thermal code? | %d\n", run_thermal); printf("| Generate core crack aTP table? | %d\n", run_aTP); printf("| Generate water alpha beta table? | %d\n", run_alpha_beta); printf("| Generate crack species log K with CHNOSZ? | %d\n", run_crack_species); printf("| Run geochemistry code? (min max step) | %d\n", run_geochem); printf("| Temperature | %g %g %g\n", Tmin, Tmax, Tstep); printf("| Pressure | %g %g %g\n", Pmin, Pmax, Pstep); printf("| pe = FMQ + ... | %g %g %g\n", pemin, pemax, pestep); printf("| Water:rock mass ratio | %g %g %g\n", WRmin, WRmax, WRstep); printf("| Run compression code? | %d\n", run_compression); printf("| Run cryovolcanism code? | %d\n", run_cryolava); printf("| After how many output steps? | %d\n", t_cryolava); printf("| Minimum temperature to run CHNOSZ (K) | %g\n", CHNOSZ_T_MIN); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Core crack options |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||\n"); printf("|-----------------------------------------------|------------------------------------------------------|\n"); printf("| Include thermal expansion/contrac mismatch? | %d\n", crack_input[0]); printf("| Include pore water expansion? | %d\n", crack_input[1]); printf("| Include hydration/dehydration vol changes? | %d\n", crack_input[2]); printf("| Include dissolution/precipitation...? | %d\n", crack_input[3]); printf("| ... of silica? | %d\n", crack_species[0]); printf("| ... of serpentine? | %d\n", crack_species[1]); printf("| ... of carbonate (magnesite)? | %d\n", crack_species[2]); printf("|------------------------------------------------------------------------------------------------------|\n\n"); // Conversions to cgs total_time = total_time*Myr2sec; output_every = output_every*Myr2sec; Mprim = Mprim/gram; Rprim = Rprim*km2cm; Mring = Mring/gram; aring_in = aring_in*km2cm; aring_out = aring_out*km2cm; for (im=0;im<nmoons;im++) { r_p[im] = r_p[im]*km2cm; tzero[im] = tzero[im]*Myr2sec; aorb[im] = aorb[im]*km2cm; } // Conversions to SI rhoDryRock = rhoDryRock*gram/cm/cm/cm; rhoHydrRock = rhoHydrRock*gram/cm/cm/cm; NT_output = floor(total_time/output_every)+1; //------------------------------------------------------------------- // Cracking depth calculations //------------------------------------------------------------------- if (run_aTP == 1) { printf("Calculating expansion mismatch optimal flaw size matrix...\n"); aTP(path, warnings); printf("\n"); } if (run_alpha_beta == 1) { printf("Calculating alpha(T,P) and beta(T,P) tables for water using CHNOSZ...\n"); Crack_water_CHNOSZ(argc, argv, path, warnings); printf("\n"); } if (run_crack_species == 1) { printf("Calculating log K for crack species using CHNOSZ...\n"); Crack_species_CHNOSZ(argc, argv, path, warnings); printf("\n"); } //------------------------------------------------------------------- // Run thermal code //------------------------------------------------------------------- double **Xhydr = (double**) malloc(nmoons*sizeof(double*)); // Degree of hydration, 0=dry, 1=hydrated if (Xhydr == NULL) printf("IcyDwarf: Not enough memory to create Xhydr[nmoons]\n"); for (im=0;im<nmoons;im++) { Xhydr[im] = (double*) malloc(NR*sizeof(double)); if (Xhydr[im] == NULL) printf("Thermal: Not enough memory to create Xhydr[nmoons][NR]\n"); } for (im=0;im<nmoons;im++) { for (ir=0;ir<NR;ir++) Xhydr[im][ir] = Xhydr_init[im]; } if (run_thermal == 1) { printf("Running thermal evolution code...\n"); PlanetSystem(argc, argv, path, warnings, recover, NR, timestep, speedup, tzero, total_time, output_every, nmoons, Mprim, Rprim, Qprimi, Qprimf, Qmode, k2prim, J2prim, J4prim, Mring, aring_out, aring_in, r_p, rho_p, rhoHydrRock, rhoDryRock, nh3, salt, Xhydr, porosity, Xpores, Xfines, Tinit, Tsurf, startdiff, aorb, eorb, tidalmodel, tidetimes, orbevol, hy, chondr, crack_input, crack_species); printf("\n"); } //------------------------------------------------------------------- // Water-rock reactions //------------------------------------------------------------------- if (run_geochem == 1) { printf("Running PHREEQC across the specified range of parameters...\n"); ParamExploration(path, Tmin, Tmax, Tstep, Pmin, Pmax, Pstep, pemin, pemax, pestep, WRmin, WRmax, WRstep); printf("\n"); } //------------------------------------------------------------------- // Compression //------------------------------------------------------------------- if (run_compression == 1) { printf("Running Compression routine...\n"); // Read thermal output thermalout **thoutput = (thermalout**) malloc(NR*sizeof(thermalout*)); // Thermal model output if (thoutput == NULL) printf("IcyDwarf: Not enough memory to create the thoutput structure\n"); for (ir=0;ir<NR;ir++) { thoutput[ir] = (thermalout*) malloc(NT_output*sizeof(thermalout)); if (thoutput[ir] == NULL) printf("IcyDwarf: Not enough memory to create the thoutput structure\n"); } thoutput = read_thermal_output (thoutput, NR, NT_output, path); compression(NR, NT_output, thoutput, NT_output-1, 205, 302, 403, 0, path, rhoHydrRock, rhoDryRock, Xhydr[0]); for (ir=0;ir<NR;ir++) free (thoutput[ir]); free (thoutput); printf("\n"); } //------------------------------------------------------------------- // Cryolava calculations //------------------------------------------------------------------- if (run_cryolava == 1) { printf("Calculating gas-driven exsolution at t=%d...\n", t_cryolava); // Read thermal output thermalout **thoutput = (thermalout**) malloc(NR*sizeof(thermalout*)); // Thermal model output if (thoutput == NULL) printf("IcyDwarf: Not enough memory to create the thoutput structure\n"); for (ir=0;ir<NR;ir++) { thoutput[ir] = (thermalout*) malloc(NT_output*sizeof(thermalout)); if (thoutput[ir] == NULL) printf("IcyDwarf: Not enough memory to create the thoutput structure\n"); } thoutput = read_thermal_output (thoutput, NR, NT_output, path); for (ir=0;ir<NR;ir++) Xhydr[0][ir] = thoutput[ir][NT_output].xhydr; if (t_cryolava > NT_output) { printf("Icy Dwarf: t_cryolava > total time of sim\n"); return -1; } Cryolava(argc, argv, path, NR, NT_output, (float) r_p[0], thoutput, t_cryolava, CHNOSZ_T_MIN, warnings, rhoHydrRock, rhoDryRock, Xhydr[0]); for (ir=0;ir<NR;ir++) free (thoutput[ir]); free (thoutput); printf("\n"); } //------------------------------------------------------------------- // Exit //------------------------------------------------------------------- for (im=0;im<nmoons;im++) free(Xhydr[im]); free (input); free (crack_input); free (crack_species); free (Xhydr); Rf_endEmbeddedR(0); // Close R and CHNOSZ printf("Exiting IcyDwarf...\n"); return 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 */ }