void InitTempDir()
{
char *tmp, *tm, tmp1[PATH_MAX+10], *p;
int len;
#ifndef HAVE_MKDTEMP
int res;
#endif
tmp = getenv("R_SESSION_TMPDIR");
if (!tmp) {
/* This looks like it will only be called in the embedded case
since this is done in the script. Also should test if directory
exists rather than just attempting to remove it.
*/
char *buf;
tm = getenv("TMPDIR");
if (!tm) tm = getenv("TMP");
if (!tm) tm = getenv("TEMP");
if (!tm) tm = "/tmp";
#ifdef HAVE_MKDTEMP
sprintf(tmp1, "%s/RtmpXXXXXX", tm);
tmp = mkdtemp(tmp1);
if(!tmp) R_Suicide(_("cannot mkdir R_TempDir"));
#else
sprintf(tmp1, "rm -rf %s/Rtmp%u", tm, (unsigned int)getpid());
R_system(tmp1);
sprintf(tmp1, "%s/Rtmp%u", tm, (unsigned int)getpid());
res = mkdir(tmp1, 0755);
if(res) {
/* Try one more time, in case a dir left around from that
process number from another user */
sprintf(tmp1, "rm -rf %s/Rtmp%u-%d", tm, (unsigned int)getpid(),
rand() % 1000);
R_system(tmp1);
sprintf(tmp1, "%s/Rtmp%u-%d", tm, (unsigned int)getpid(),
rand() % 1000);
res = mkdir(tmp1, 0755);
}
if(res) R_Suicide(_("cannot mkdir R_TempDir"));
#endif
tmp = tmp1;
buf = (char *) malloc((strlen(tmp) + 20) * sizeof(char));
if(buf) {
sprintf(buf, "R_SESSION_TMPDIR=%s", tmp);
putenv(buf);
/* no free here: storage remains in use */
}
}
len = strlen(tmp) + 1;
p = (char *) malloc(len);
if(!p) R_Suicide(_("cannot allocate R_TempDir"));
else {
R_TempDir = p;
strcpy(R_TempDir, tmp);
}
}
static void Putenv(char *a, char *b)
{
char *buf, *value, *p, *q, quote='\0';
int inquote = 0;
#ifdef HAVE_SETENV
buf = (char *) malloc((strlen(b) + 1) * sizeof(char));
if(!buf) R_Suicide("allocation failure in reading Renviron");
value = buf;
#else
buf = (char *) malloc((strlen(a) + strlen(b) + 2) * sizeof(char));
if(!buf) R_Suicide("allocation failure in reading Renviron");
strcpy(buf, a); strcat(buf, "=");
value = buf+strlen(buf);
#endif
/* now process the value */
for(p = b, q = value; *p; p++) {
/* remove quotes around sections, preserve \ inside quotes */
if(!inquote && (*p == '"' || *p == '\'')) {
inquote = 1;
quote = *p;
continue;
}
if(inquote && *p == quote && *(p-1) != '\\') {
inquote = 0;
continue;
}
if(!inquote && *p == '\\') {
if(*(p+1) == '\n') p++;
else if(*(p+1) == '\\') *q++ = *p;
continue;
}
if(inquote && *p == '\\' && *(p+1) == quote) continue;
*q++ = *p;
}
*q = '\0';
#ifdef HAVE_SETENV
if(setenv(a, buf, 1))
warningcall(R_NilValue,
_("problem in setting variable '%s' in Renviron"), a);
free(buf);
#elif defined(HAVE_PUTENV)
if(putenv(buf))
warningcall(R_NilValue,
_("problem in setting variable '%s' in Renviron"), a);
/* no free here: storage remains in use */
#else
/* pretty pointless, and was not tested prior to 2.3.0 */
free(buf);
#endif
}
char *getDLLVersion(void)
{
static char DLLversion[25];
OSVERSIONINFO osvi;
osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&osvi);
/* 95, 98, ME are 4.x */
if(osvi.dwMajorVersion < 5)
R_Suicide("Windows 2000 or later is required");
snprintf(DLLversion, 25, "%s.%s", R_MAJOR, R_MINOR);
return (DLLversion);
}
void attribute_hidden InitTempDir()
{
char *tmp, *tm, tmp1[PATH_MAX+11], *p;
#ifdef Win32
char tmp2[PATH_MAX];
int hasspace = 0;
#endif
if(R_TempDir) return; /* someone else set it */
tmp = NULL; /* getenv("R_SESSION_TMPDIR"); no longer set in R.sh */
if (!tmp) {
tm = getenv("TMPDIR");
if (!isDir(tm)) {
tm = getenv("TMP");
if (!isDir(tm)) {
tm = getenv("TEMP");
if (!isDir(tm))
#ifdef Win32
tm = getenv("R_USER"); /* this one will succeed */
#else
tm = "/tmp";
#endif
}
}
#ifdef Win32
/* make sure no spaces in path */
for (p = tm; *p; p++)
if (isspace(*p)) { hasspace = 1; break; }
if (hasspace) {
GetShortPathName(tm, tmp2, MAX_PATH);
tm = tmp2;
}
snprintf(tmp1, PATH_MAX+11, "%s\\RtmpXXXXXX", tm);
#else
snprintf(tmp1, PATH_MAX+11, "%s/RtmpXXXXXX", tm);
#endif
tmp = mkdtemp(tmp1);
if(!tmp) R_Suicide(_("cannot create 'R_TempDir'"));
#ifndef Win32
# ifdef HAVE_SETENV
if(setenv("R_SESSION_TMPDIR", tmp, 1))
errorcall(R_NilValue, _("unable to set R_SESSION_TMPDIR"));
# elif defined(HAVE_PUTENV)
{
size_t len = strlen(tmp) + 20;
char * buf = (char *) malloc((len) * sizeof(char));
if(buf) {
snprintf(buf, len, "R_SESSION_TMPDIR=%s", tmp);
if(putenv(buf))
errorcall(R_NilValue, _("unable to set R_SESSION_TMPDIR"));
/* no free here: storage remains in use */
} else
errorcall(R_NilValue, _("unable to set R_SESSION_TMPDIR"));
}
# endif
#endif
}
size_t len = strlen(tmp) + 1;
p = (char *) malloc(len);
if(!p)
R_Suicide(_("cannot allocate 'R_TempDir'"));
else {
R_TempDir = p;
strcpy(R_TempDir, tmp);
Sys_TempDir = R_TempDir;
}
}
void setup_Rmainloop(void)
{
volatile int doneit;
volatile SEXP baseEnv;
SEXP cmd;
char deferred_warnings[11][250];
volatile int ndeferred_warnings = 0;
/* In case this is a silly limit: 2^32 -3 has been seen and
* casting to intptr_r relies on this being smaller than 2^31 on a
* 32-bit platform. */
if(R_CStackLimit > 100000000U)
R_CStackLimit = (uintptr_t)-1;
/* make sure we have enough head room to handle errors */
if(R_CStackLimit != -1)
R_CStackLimit = (uintptr_t)(0.95 * R_CStackLimit);
InitConnections(); /* needed to get any output at all */
/* Initialize the interpreter's internal structures. */
#ifdef HAVE_LOCALE_H
#ifdef Win32
{
char *p, Rlocale[1000]; /* Windows' locales can be very long */
p = getenv("LC_ALL");
strncpy(Rlocale, p ? p : "", 1000);
Rlocale[1000 - 1] = '\0';
if(!(p = getenv("LC_CTYPE"))) p = Rlocale;
/* We'd like to use warning, but need to defer.
Also cannot translate. */
if(!setlocale(LC_CTYPE, p))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_CTYPE=%s failed\n", p);
if((p = getenv("LC_COLLATE"))) {
if(!setlocale(LC_COLLATE, p))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_COLLATE=%s failed\n", p);
} else setlocale(LC_COLLATE, Rlocale);
if((p = getenv("LC_TIME"))) {
if(!setlocale(LC_TIME, p))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_TIME=%s failed\n", p);
} else setlocale(LC_TIME, Rlocale);
if((p = getenv("LC_MONETARY"))) {
if(!setlocale(LC_MONETARY, p))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_MONETARY=%s failed\n", p);
} else setlocale(LC_MONETARY, Rlocale);
/* Windows does not have LC_MESSAGES */
/* We set R_ARCH here: Unix does it in the shell front-end */
char Rarch[30];
strcpy(Rarch, "R_ARCH=/");
strcat(Rarch, R_ARCH);
putenv(Rarch);
}
#else /* not Win32 */
if(!setlocale(LC_CTYPE, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_CTYPE failed, using \"C\"\n");
if(!setlocale(LC_COLLATE, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_COLLATE failed, using \"C\"\n");
if(!setlocale(LC_TIME, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_TIME failed, using \"C\"\n");
#ifdef ENABLE_NLS
if(!setlocale(LC_MESSAGES, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_MESSAGES failed, using \"C\"\n");
#endif
/* NB: we do not set LC_NUMERIC */
#ifdef LC_MONETARY
if(!setlocale(LC_MONETARY, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_MONETARY failed, using \"C\"\n");
#endif
#ifdef LC_PAPER
if(!setlocale(LC_PAPER, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_PAPER failed, using \"C\"\n");
#endif
#ifdef LC_MEASUREMENT
if(!setlocale(LC_MEASUREMENT, ""))
snprintf(deferred_warnings[ndeferred_warnings++], 250,
"Setting LC_MEASUREMENT failed, using \"C\"\n");
#endif
#endif /* not Win32 */
#endif
/* make sure srand is called before R_tmpnam, PR#14381 */
srand(TimeToSeed());
InitArithmetic();
InitParser();
InitTempDir(); /* must be before InitEd */
InitMemory();
InitStringHash(); /* must be before InitNames */
InitNames();
InitBaseEnv();
InitGlobalEnv();
InitDynload();
InitOptions();
InitEd();
InitGraphics();
InitTypeTables(); /* must be before InitS3DefaultTypes */
InitS3DefaultTypes();
R_Is_Running = 1;
R_check_locale();
/* Initialize the global context for error handling. */
/* This provides a target for any non-local gotos */
/* which occur during error handling */
R_Toplevel.nextcontext = NULL;
R_Toplevel.callflag = CTXT_TOPLEVEL;
R_Toplevel.cstacktop = 0;
R_Toplevel.promargs = R_NilValue;
R_Toplevel.callfun = R_NilValue;
R_Toplevel.call = R_NilValue;
R_Toplevel.cloenv = R_BaseEnv;
R_Toplevel.sysparent = R_BaseEnv;
R_Toplevel.conexit = R_NilValue;
R_Toplevel.vmax = NULL;
R_Toplevel.nodestack = R_BCNodeStackTop;
#ifdef BC_INT_STACK
R_Toplevel.intstack = R_BCIntStackTop;
#endif
R_Toplevel.cend = NULL;
R_Toplevel.intsusp = FALSE;
R_Toplevel.handlerstack = R_HandlerStack;
R_Toplevel.restartstack = R_RestartStack;
R_Toplevel.srcref = R_NilValue;
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
R_ExitContext = NULL;
R_Warnings = R_NilValue;
/* This is the same as R_BaseEnv, but this marks the environment
of functions as the namespace and not the package. */
baseEnv = R_BaseNamespace;
/* Set up some global variables */
Init_R_Variables(baseEnv);
/* On initial entry we open the base language package and begin by
running the repl on it.
If there is an error we pass on to the repl.
Perhaps it makes more sense to quit gracefully?
*/
#ifdef RMIN_ONLY
/* This is intended to support a minimal build for experimentation. */
if (R_SignalHandlers) init_signal_handlers();
#else
FILE *fp = R_OpenLibraryFile("base");
if (fp == NULL)
R_Suicide(_("unable to open the base package\n"));
doneit = 0;
SETJMP(R_Toplevel.cjmpbuf);
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
if (R_SignalHandlers) init_signal_handlers();
if (!doneit) {
doneit = 1;
R_ReplFile(fp, baseEnv);
}
fclose(fp);
#endif
/* This is where we source the system-wide, the site's and the
user's profile (in that order). If there is an error, we
drop through to further processing.
*/
R_IoBufferInit(&R_ConsoleIob);
R_LoadProfile(R_OpenSysInitFile(), baseEnv);
/* These are the same bindings, so only lock them once */
R_LockEnvironment(R_BaseNamespace, TRUE);
#ifdef NOTYET
/* methods package needs to trample here */
R_LockEnvironment(R_BaseEnv, TRUE);
#endif
/* At least temporarily unlock some bindings used in graphics */
R_unLockBinding(R_DeviceSymbol, R_BaseEnv);
R_unLockBinding(R_DevicesSymbol, R_BaseEnv);
R_unLockBinding(install(".Library.site"), R_BaseEnv);
/* require(methods) if it is in the default packages */
doneit = 0;
SETJMP(R_Toplevel.cjmpbuf);
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
if (!doneit) {
doneit = 1;
PROTECT(cmd = install(".OptRequireMethods"));
R_CurrentExpr = findVar(cmd, R_GlobalEnv);
if (R_CurrentExpr != R_UnboundValue &&
TYPEOF(R_CurrentExpr) == CLOSXP) {
PROTECT(R_CurrentExpr = lang1(cmd));
R_CurrentExpr = eval(R_CurrentExpr, R_GlobalEnv);
UNPROTECT(1);
}
UNPROTECT(1);
}
if (strcmp(R_GUIType, "Tk") == 0) {
char buf[PATH_MAX];
snprintf(buf, PATH_MAX, "%s/library/tcltk/exec/Tk-frontend.R", R_Home);
R_LoadProfile(R_fopen(buf, "r"), R_GlobalEnv);
}
/* Print a platform and version dependent greeting and a pointer to
* the copyleft.
*/
if(!R_Quiet) PrintGreeting();
R_LoadProfile(R_OpenSiteFile(), baseEnv);
R_LockBinding(install(".Library.site"), R_BaseEnv);
R_LoadProfile(R_OpenInitFile(), R_GlobalEnv);
/* This is where we try to load a user's saved data.
The right thing to do here is very platform dependent.
E.g. under Unix we look in a special hidden file and on the Mac
we look in any documents which might have been double clicked on
or dropped on the application.
*/
doneit = 0;
SETJMP(R_Toplevel.cjmpbuf);
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
if (!doneit) {
doneit = 1;
R_InitialData();
}
else {
if (! SETJMP(R_Toplevel.cjmpbuf)) {
warning(_("unable to restore saved data in %s\n"), get_workspace_name());
}
}
/* Initial Loading is done.
At this point we try to invoke the .First Function.
If there is an error we continue. */
doneit = 0;
SETJMP(R_Toplevel.cjmpbuf);
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
if (!doneit) {
doneit = 1;
PROTECT(cmd = install(".First"));
R_CurrentExpr = findVar(cmd, R_GlobalEnv);
if (R_CurrentExpr != R_UnboundValue &&
TYPEOF(R_CurrentExpr) == CLOSXP) {
PROTECT(R_CurrentExpr = lang1(cmd));
R_CurrentExpr = eval(R_CurrentExpr, R_GlobalEnv);
UNPROTECT(1);
}
UNPROTECT(1);
}
/* Try to invoke the .First.sys function, which loads the default packages.
If there is an error we continue. */
doneit = 0;
SETJMP(R_Toplevel.cjmpbuf);
R_GlobalContext = R_ToplevelContext = R_SessionContext = &R_Toplevel;
if (!doneit) {
doneit = 1;
PROTECT(cmd = install(".First.sys"));
R_CurrentExpr = findVar(cmd, baseEnv);
if (R_CurrentExpr != R_UnboundValue &&
TYPEOF(R_CurrentExpr) == CLOSXP) {
PROTECT(R_CurrentExpr = lang1(cmd));
R_CurrentExpr = eval(R_CurrentExpr, R_GlobalEnv);
UNPROTECT(1);
}
UNPROTECT(1);
}
{
int i;
for(i = 0 ; i < ndeferred_warnings; i++)
warning(deferred_warnings[i]);
}
if (R_CollectWarnings) {
REprintf(_("During startup - "));
PrintWarnings();
}
/* trying to do this earlier seems to run into bootstrapping issues. */
R_init_jit_enabled();
R_Is_Running = 2;
}
int Rf_initialize_R(int ac, char **av)
{
int i, ioff = 1, j;
Rboolean useX11 = TRUE, useTk = FALSE;
char *p, msg[1024], cmdlines[10000], **avv;
structRstart rstart;
Rstart Rp = &rstart;
Rboolean force_interactive = FALSE;
#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_GETRLIMIT)
{
struct rlimit rlim;
{
uintptr_t ii = dummy_ii();
/* 1 is downwards */
R_CStackDir = ((uintptr_t)&i > ii) ? 1 : -1;
}
if(getrlimit(RLIMIT_STACK, &rlim) == 0) {
unsigned long lim1, lim2;
lim1 = (unsigned long) rlim.rlim_cur;
lim2 = (unsigned long) rlim.rlim_max; /* Usually unlimited */
R_CStackLimit = lim1 < lim2 ? lim1 : lim2;
}
#if defined(HAVE_LIBC_STACK_END)
R_CStackStart = (uintptr_t) __libc_stack_end;
#elif defined(HAVE_KERN_USRSTACK)
{
/* Borrowed from mzscheme/gc/os_dep.c */
int nm[2] = {CTL_KERN, KERN_USRSTACK};
void * base;
size_t len = sizeof(void *);
(void) sysctl(nm, 2, &base, &len, NULL, 0);
R_CStackStart = (uintptr_t) base;
}
#else
if(R_running_as_main_program) {
/* This is not the main program, but unless embedded it is
near the top, 5540 bytes away when checked. */
R_CStackStart = (uintptr_t) &i + (6000 * R_CStackDir);
}
#endif
if(R_CStackStart == -1) R_CStackLimit = -1; /* never set */
/* printf("stack limit %ld, start %lx dir %d \n", R_CStackLimit,
R_CStackStart, R_CStackDir); */
}
#endif
ptr_R_Suicide = Rstd_Suicide;
ptr_R_ShowMessage = Rstd_ShowMessage;
ptr_R_ReadConsole = Rstd_ReadConsole;
ptr_R_WriteConsole = Rstd_WriteConsole;
ptr_R_ResetConsole = Rstd_ResetConsole;
ptr_R_FlushConsole = Rstd_FlushConsole;
ptr_R_ClearerrConsole = Rstd_ClearerrConsole;
ptr_R_Busy = Rstd_Busy;
ptr_R_CleanUp = Rstd_CleanUp;
ptr_R_ShowFiles = Rstd_ShowFiles;
ptr_R_ChooseFile = Rstd_ChooseFile;
ptr_R_loadhistory = Rstd_loadhistory;
ptr_R_savehistory = Rstd_savehistory;
ptr_R_addhistory = Rstd_addhistory;
ptr_R_EditFile = NULL; /* for future expansion */
R_timeout_handler = NULL;
R_timeout_val = 0;
R_GlobalContext = NULL; /* Make R_Suicide less messy... */
if((R_Home = R_HomeDir()) == NULL)
R_Suicide("R home directory is not defined");
BindDomain(R_Home);
process_system_Renviron();
R_setStartTime();
R_DefParams(Rp);
/* Store the command line arguments before they are processed
by the R option handler.
*/
R_set_command_line_arguments(ac, av);
cmdlines[0] = '\0';
/* first task is to select the GUI.
If run from the shell script, only Tk|tk|X11|x11 are allowed.
*/
for(i = 0, avv = av; i < ac; i++, avv++) {
if(!strncmp(*avv, "--gui", 5) || !strncmp(*avv, "-g", 2)) {
if(!strncmp(*avv, "--gui", 5) && strlen(*avv) >= 7)
p = &(*avv)[6];
else {
if(i+1 < ac) {
avv++; p = *avv; ioff++;
} else {
snprintf(msg, 1024,
_("WARNING: --gui or -g without value ignored"));
R_ShowMessage(msg);
p = "X11";
}
}
if(!strcmp(p, "none"))
useX11 = FALSE; // not allowed from R.sh
#ifdef HAVE_AQUA
else if(!strcmp(p, "aqua"))
useaqua = TRUE; // not allowed from R.sh but used by R.app
#endif
else if(!strcmp(p, "X11") || !strcmp(p, "x11"))
useX11 = TRUE;
else if(!strcmp(p, "Tk") || !strcmp(p, "tk"))
useTk = TRUE;
else {
#ifdef HAVE_X11
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using X11\n"), p);
#else
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using none\n"), p);
#endif
R_ShowMessage(msg);
}
/* now remove it/them */
for(j = i; j < ac - ioff; j++)
av[j] = av[j + ioff];
ac -= ioff;
break;
}
}
#ifdef HAVE_X11
if(useX11) R_GUIType = "X11";
#endif /* HAVE_X11 */
#ifdef HAVE_AQUA
if(useaqua) R_GUIType = "AQUA";
#endif
#ifdef HAVE_TCLTK
if(useTk) R_GUIType = "Tk";
#endif
R_common_command_line(&ac, av, Rp);
while (--ac) {
if (**++av == '-') {
if(!strcmp(*av, "--no-readline")) {
UsingReadline = FALSE;
} else if(!strcmp(*av, "-f")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strcmp(*av, "-")) {
/* Undo the escaping done in the front end */
char path[PATH_MAX], *p = path, *q;
for(q = *av; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p = '\0';
ifp = R_fopen(path, "r");
if(!ifp) {
snprintf(msg, 1024,
_("cannot open file '%s': %s"),
path, strerror(errno));
R_Suicide(msg);
}
}
} else if(!strncmp(*av, "--file=", 7)) {
Rp->R_Interactive = FALSE;
if(strcmp((*av)+7, "-")) {
/* Undo the escaping done in the front end */
char path[PATH_MAX], *p = path, *q;
for(q = (*av)+7; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p = '\0';
ifp = R_fopen(path, "r");
if(!ifp) {
snprintf(msg, 1024,
_("cannot open file '%s': %s"),
path, strerror(errno));
R_Suicide(msg);
}
}
} else if(!strcmp(*av, "-e")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strlen(cmdlines) + strlen(*av) + 2 <= 10000) {
char *p = cmdlines+strlen(cmdlines), *q;
/* Undo the escaping done in the front end */
for(q = *av; *q; q++) {
if(*q == '~' && *(q+1) == '+' && *(q+2) == '~') {
q += 2;
*p++ = ' ';
} else *p++ = *q;
}
*p++ = '\n'; *p = '\0';
} else {
snprintf(msg, 1024, _("WARNING: '-e %s' omitted as input is too long\n"), *av);
R_ShowMessage(msg);
}
} else if(!strcmp(*av, "--args")) {
break;
} else if(!strcmp(*av, "--interactive")) {
force_interactive = TRUE;
break;
} else {
#ifdef HAVE_AQUA
// r27492: in 2003 launching from 'Finder OSX' passed this
if(!strncmp(*av, "-psn", 4)) break; else
#endif
snprintf(msg, 1024, _("WARNING: unknown option '%s'\n"), *av);
R_ShowMessage(msg);
}
} else {
snprintf(msg, 1024, _("ARGUMENT '%s' __ignored__\n"), *av);
R_ShowMessage(msg);
}
}
if(strlen(cmdlines)) { /* had at least one -e option */
size_t res;
if(ifp) R_Suicide(_("cannot use -e with -f or --file"));
ifp = tmpfile();
if(!ifp) R_Suicide(_("creating temporary file for '-e' failed"));
res = fwrite(cmdlines, strlen(cmdlines)+1, 1, ifp);
if(res != 1) error("fwrite error in initialize_R");
fflush(ifp);
rewind(ifp);
}
if (ifp && Rp->SaveAction != SA_SAVE) Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
if(!Rp->NoRenviron) {
process_site_Renviron();
process_user_Renviron();
}
/* On Unix the console is a file; we just use stdio to write on it */
#ifdef HAVE_AQUA
if(useaqua)
R_Interactive = useaqua;
else
#endif
R_Interactive = R_Interactive && (force_interactive || isatty(0));
#ifdef HAVE_AQUA
/* for Aqua and non-dumb terminal use callbacks instead of connections
and pretty-print warnings/errors (ESS = dumb terminal) */
if(useaqua ||
(R_Interactive && getenv("TERM") && strcmp(getenv("TERM"), "dumb"))) {
R_Outputfile = NULL;
R_Consolefile = NULL;
ptr_R_WriteConsoleEx = Rstd_WriteConsoleEx;
ptr_R_WriteConsole = NULL;
} else {
#endif
R_Outputfile = stdout;
R_Consolefile = stderr;
#ifdef HAVE_AQUA
}
#endif
/*
* Since users' expectations for save/no-save will differ, we decided
* that they should be forced to specify in the non-interactive case.
*/
if (!R_Interactive && Rp->SaveAction != SA_SAVE &&
Rp->SaveAction != SA_NOSAVE)
R_Suicide(_("you must specify '--save', '--no-save' or '--vanilla'"));
R_setupHistory();
if (R_RestoreHistory)
Rstd_read_history(R_HistoryFile);
fpu_setup(1);
return(0);
}
int Rf_initialize_R(int ac, char **av)
{
int i, ioff = 1, j;
Rboolean useX11 = TRUE, useTk = FALSE;
char *p, msg[1024], cmdlines[10000], **avv;
structRstart rstart;
Rstart Rp = &rstart;
Rboolean force_interactive = FALSE;
if (num_initialized++) {
fprintf(stderr, "%s", "R is already initialized\n");
exit(1);
}
#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_GETRLIMIT)
{
/* getrlimit is POSIX:
http://pubs.opengroup.org/onlinepubs/9699919799/functions/getrlimit.html
*/
struct rlimit rlim;
{
uintptr_t ii = dummy_ii();
/* 1 is downwards */
R_CStackDir = ((uintptr_t)&i > ii) ? 1 : -1;
}
if(getrlimit(RLIMIT_STACK, &rlim) == 0) {
/* 'unlimited' is represented by RLIM_INFINITY, which is a
very large (but maybe not the largest) representable value.
The standard allows the values RLIM_SAVED_CUR and
RLIB_SAVED_MAX, apparently used on 32-bit AIX.
(http://www.ibm.com/support/knowledgecenter/ssw_aix_61/com.ibm.aix.basetrf1/getrlimit_64.htm)
These may or may not be different from RLIM_INFINITY (they
are the same on Linux and macOS but not Solaris where they
are larger). We will assume that unrepresentable limits
are very large.
This is cautious: it is extremely unlikely that the soft
limit is either unlimited or unrepresentable.
*/
rlim_t lim = rlim.rlim_cur;
#if defined(RLIM_SAVED_CUR) && defined(RLIM_SAVED_MAX)
if (lim == RLIM_SAVED_CUR || lim == RLIM_SAVED_MAX)
lim = RLIM_INFINITY;
#endif
if (lim != RLIM_INFINITY) R_CStackLimit = (uintptr_t) lim;
}
#if defined(HAVE_LIBC_STACK_END)
{
R_CStackStart = (uintptr_t) __libc_stack_end;
/* The libc stack end is not exactly at the stack start, so one
cannot access __libc_stack_end - R_CStackLimit/getrlimit + 1. We
have to find the real stack start that matches getrlimit.
A modern alternative to __libc_stack_end and to parsing /proc/maps
directly is pthread_getattr_np; it doesn't provide the exact stack
start, either, but provides a matching stack size smaller than
the one obtained from getrlimit. However, pthread_getattr_np
may have not worked properly on old Linux distributions. */
/* based on GDB relocatable.c */
FILE *f;
f = fopen("/proc/self/maps", "r");
if (f) {
for(;;) {
int c;
unsigned long start, end;
if (fscanf(f, "%lx-%lx", &start, &end) == 2 &&
R_CStackStart >= (uintptr_t)start &&
R_CStackStart < (uintptr_t)end) {
/* would this be ok for R_CStackDir == -1? */
R_CStackStart = (uintptr_t) ((R_CStackDir == 1) ? end : start);
break;
}
for(c = getc(f); c != '\n' && c != EOF; c = getc(f));
if (c == EOF) {
/* could also abort here, but R will usually work with
R_CStackStart set just for __libc_stack_end */
fprintf(stderr, "WARNING: Error parsing /proc/self/maps!\n");
break;
}
}
fclose(f);
}
}
#elif defined(HAVE_KERN_USRSTACK)
{
/* Borrowed from mzscheme/gc/os_dep.c */
int nm[2] = {CTL_KERN, KERN_USRSTACK};
void * base;
size_t len = sizeof(void *);
(void) sysctl(nm, 2, &base, &len, NULL, 0);
R_CStackStart = (uintptr_t) base;
}
#elif defined(HAVE_THR_STKSEGMENT)
{
/* Solaris */
stack_t stack;
if (thr_stksegment(&stack))
R_Suicide("Cannot obtain stack information (thr_stksegment).");
R_CStackStart = (uintptr_t) stack.ss_sp;
/* This _may_ have to be adjusted for a (perhaps theoretical) platform
where the stack would grow upwards.
The stack size could be updated based on stack.ss_size, but experiments
suggest getrlimit is safe here. */
}
#else
if(R_running_as_main_program) {
/* This is not the main program, but unless embedded it is
near the top, 5540 bytes away when checked. */
R_CStackStart = (uintptr_t) &i + (6000 * R_CStackDir);
}
#endif
if(R_CStackStart == (uintptr_t)(-1)) R_CStackLimit = (uintptr_t)(-1); /* never set */
/* setup_Rmainloop includes (disabled) code to test stack detection */
}
#endif
ptr_R_Suicide = Rstd_Suicide;
ptr_R_ShowMessage = Rstd_ShowMessage;
ptr_R_ReadConsole = Rstd_ReadConsole;
ptr_R_WriteConsole = Rstd_WriteConsole;
ptr_R_ResetConsole = Rstd_ResetConsole;
ptr_R_FlushConsole = Rstd_FlushConsole;
ptr_R_ClearerrConsole = Rstd_ClearerrConsole;
ptr_R_Busy = Rstd_Busy;
ptr_R_CleanUp = Rstd_CleanUp;
ptr_R_ShowFiles = Rstd_ShowFiles;
ptr_R_ChooseFile = Rstd_ChooseFile;
ptr_R_loadhistory = Rstd_loadhistory;
ptr_R_savehistory = Rstd_savehistory;
ptr_R_addhistory = Rstd_addhistory;
ptr_R_EditFile = NULL; /* for future expansion */
R_timeout_handler = NULL;
R_timeout_val = 0;
R_GlobalContext = NULL; /* Make R_Suicide less messy... */
if((R_Home = R_HomeDir()) == NULL)
R_Suicide("R home directory is not defined");
BindDomain(R_Home);
process_system_Renviron();
R_setStartTime();
R_DefParams(Rp);
/* Store the command line arguments before they are processed
by the R option handler.
*/
R_set_command_line_arguments(ac, av);
cmdlines[0] = '\0';
/* first task is to select the GUI.
If run from the shell script, only Tk|tk|X11|x11 are allowed.
*/
for(i = 0, avv = av; i < ac; i++, avv++) {
if (!strcmp(*avv, "--args"))
break;
if(!strncmp(*avv, "--gui", 5) || !strncmp(*avv, "-g", 2)) {
if(!strncmp(*avv, "--gui", 5) && strlen(*avv) >= 7)
p = &(*avv)[6];
else {
if(i+1 < ac) {
avv++; p = *avv; ioff++;
} else {
snprintf(msg, 1024,
_("WARNING: --gui or -g without value ignored"));
R_ShowMessage(msg);
p = "X11";
}
}
if(!strcmp(p, "none"))
useX11 = FALSE; // not allowed from R.sh
#ifdef HAVE_AQUA
else if(!strcmp(p, "aqua"))
useaqua = TRUE; // not allowed from R.sh but used by R.app
#endif
else if(!strcmp(p, "X11") || !strcmp(p, "x11"))
useX11 = TRUE;
else if(!strcmp(p, "Tk") || !strcmp(p, "tk"))
useTk = TRUE;
else {
#ifdef HAVE_X11
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using X11\n"), p);
#else
snprintf(msg, 1024,
_("WARNING: unknown gui '%s', using none\n"), p);
#endif
R_ShowMessage(msg);
}
/* now remove it/them */
for(j = i; j < ac - ioff; j++)
av[j] = av[j + ioff];
ac -= ioff;
break;
}
}
#ifdef HAVE_X11
if(useX11) R_GUIType = "X11";
#endif /* HAVE_X11 */
#ifdef HAVE_AQUA
if(useaqua) R_GUIType = "AQUA";
#endif
#ifdef HAVE_TCLTK
if(useTk) R_GUIType = "Tk";
#endif
R_common_command_line(&ac, av, Rp);
while (--ac) {
if (**++av == '-') {
if(!strcmp(*av, "--no-readline")) {
UsingReadline = FALSE;
} else if(!strcmp(*av, "-f")) {
ac--; av++;
#define R_INIT_TREAT_F(_AV_) \
Rp->R_Interactive = FALSE; \
if(strcmp(_AV_, "-")) { \
char path[PATH_MAX], *p = path; \
p = unescape_arg(p, _AV_); \
*p = '\0'; \
ifp = R_fopen(path, "r"); \
if(!ifp) { \
snprintf(msg, 1024, \
_("cannot open file '%s': %s"), \
path, strerror(errno)); \
R_Suicide(msg); \
} \
}
R_INIT_TREAT_F(*av);
} else if(!strncmp(*av, "--file=", 7)) {
R_INIT_TREAT_F((*av)+7);
} else if(!strcmp(*av, "-e")) {
ac--; av++;
Rp->R_Interactive = FALSE;
if(strlen(cmdlines) + strlen(*av) + 2 <= 10000) {
char *p = cmdlines+strlen(cmdlines);
p = unescape_arg(p, *av);
*p++ = '\n'; *p = '\0';
} else {
snprintf(msg, 1024, _("WARNING: '-e %s' omitted as input is too long\n"), *av);
R_ShowMessage(msg);
}
} else if(!strcmp(*av, "--args")) {
break;
} else if(!strcmp(*av, "--interactive")) {
force_interactive = TRUE;
break;
} else {
#ifdef HAVE_AQUA
// r27492: in 2003 launching from 'Finder OSX' passed this
if(!strncmp(*av, "-psn", 4)) break; else
#endif
snprintf(msg, 1024, _("WARNING: unknown option '%s'\n"), *av);
R_ShowMessage(msg);
}
} else {
snprintf(msg, 1024, _("ARGUMENT '%s' __ignored__\n"), *av);
R_ShowMessage(msg);
}
}
if(strlen(cmdlines)) { /* had at least one -e option */
size_t res;
if(ifp) R_Suicide(_("cannot use -e with -f or --file"));
ifp = tmpfile();
if(!ifp) R_Suicide(_("creating temporary file for '-e' failed"));
res = fwrite(cmdlines, strlen(cmdlines)+1, 1, ifp);
if(res != 1) error("fwrite error in initialize_R");
fflush(ifp);
rewind(ifp);
}
if (ifp && Rp->SaveAction != SA_SAVE) Rp->SaveAction = SA_NOSAVE;
R_SetParams(Rp);
if(!Rp->NoRenviron) {
process_site_Renviron();
process_user_Renviron();
/* allow for R_MAX_[VN]SIZE and R_[VN]SIZE in user/site Renviron */
R_SizeFromEnv(Rp);
R_SetParams(Rp);
}
/* On Unix the console is a file; we just use stdio to write on it */
#ifdef HAVE_AQUA
if(useaqua)
R_Interactive = useaqua;
else
#endif
R_Interactive = R_Interactive && (force_interactive || isatty(0));
#ifdef HAVE_AQUA
/* for Aqua and non-dumb terminal use callbacks instead of connections
and pretty-print warnings/errors (ESS = dumb terminal) */
if(useaqua ||
(R_Interactive && getenv("TERM") && strcmp(getenv("TERM"), "dumb"))) {
R_Outputfile = NULL;
R_Consolefile = NULL;
ptr_R_WriteConsoleEx = Rstd_WriteConsoleEx;
ptr_R_WriteConsole = NULL;
} else {
#endif
R_Outputfile = stdout;
R_Consolefile = stderr;
#ifdef HAVE_AQUA
}
#endif
/*
* Since users' expectations for save/no-save will differ, we decided
* that they should be forced to specify in the non-interactive case.
*/
if (!R_Interactive && Rp->SaveAction != SA_SAVE &&
Rp->SaveAction != SA_NOSAVE)
R_Suicide(_("you must specify '--save', '--no-save' or '--vanilla'"));
R_setupHistory();
if (R_RestoreHistory)
Rstd_read_history(R_HistoryFile);
fpu_setup(1);
return(0);
}
