void R_Suicide(const char *s)
{
char pp[1024];
snprintf(pp, 1024, _("Fatal error: %s\n"), s);
R_ShowMessage(pp);
R_CleanUp(SA_SUICIDE, 2, 0);
}
static void end_Rmainloop(void)
{
/* refrain from printing trailing '\n' in slave mode */
if (!R_Slave)
Rprintf("\n");
/* run the .Last function. If it gives an error, will drop back to main
loop. */
R_CleanUp(SA_DEFAULT, 0, 1);
}
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;
}
SEXP attribute_hidden do_quit(SEXP call, SEXP op, SEXP args, SEXP rho)
{
const char *tmp;
SA_TYPE ask=SA_DEFAULT;
int status, runLast;
/* if there are any browser contexts active don't quit */
if(countContexts(CTXT_BROWSER, 1)) {
warning(_("cannot quit from browser"));
return R_NilValue;
}
if( !isString(CAR(args)) )
errorcall(call, _("one of \"yes\", \"no\", \"ask\" or \"default\" expected."));
tmp = CHAR(STRING_ELT(CAR(args), 0)); /* ASCII */
if( !strcmp(tmp, "ask") ) {
ask = SA_SAVEASK;
if(!R_Interactive)
warning(_("save=\"ask\" in non-interactive use: command-line default will be used"));
} else if( !strcmp(tmp, "no") )
ask = SA_NOSAVE;
else if( !strcmp(tmp, "yes") )
ask = SA_SAVE;
else if( !strcmp(tmp, "default") )
ask = SA_DEFAULT;
else
errorcall(call, _("unrecognized value of 'save'"));
status = asInteger(CADR(args));
if (status == NA_INTEGER) {
warning(_("invalid 'status', 0 assumed"));
runLast = 0;
}
runLast = asLogical(CADDR(args));
if (runLast == NA_LOGICAL) {
warning(_("invalid 'runLast', FALSE assumed"));
runLast = 0;
}
/* run the .Last function. If it gives an error, will drop back to main
loop. */
R_CleanUp(ask, status, runLast);
exit(0);
/*NOTREACHED*/
}
void attribute_hidden Rstd_Suicide(const char *s)
{
REprintf("Fatal error: %s\n", s);
/* Might be called before translation is running */
R_CleanUp(SA_SUICIDE, 2, 0);
}
static void sigactionSegv(int signum, siginfo_t *ip, void *context)
{
char *s;
/* First check for stack overflow if we know the stack position.
We assume anything within 16Mb beyond the stack end is a stack overflow.
*/
if(signum == SIGSEGV && (ip != (siginfo_t *)0) &&
(intptr_t) R_CStackStart != -1) {
uintptr_t addr = (uintptr_t) ip->si_addr;
intptr_t diff = (R_CStackDir > 0) ? R_CStackStart - addr:
addr - R_CStackStart;
uintptr_t upper = 0x1000000; /* 16Mb */
if((intptr_t) R_CStackLimit != -1) upper += R_CStackLimit;
if(diff > 0 && diff < upper) {
REprintf(_("Error: segfault from C stack overflow\n"));
jump_to_toplevel();
}
}
/* need to take off stack checking as stack base has changed */
R_CStackLimit = (uintptr_t)-1;
/* Do not translate these messages */
REprintf("\n *** caught %s ***\n",
signum == SIGILL ? "illegal operation" :
signum == SIGBUS ? "bus error" : "segfault");
if(ip != (siginfo_t *)0) {
if(signum == SIGILL) {
switch(ip->si_code) {
#ifdef ILL_ILLOPC
case ILL_ILLOPC:
s = "illegal opcode";
break;
#endif
#ifdef ILL_ILLOPN
case ILL_ILLOPN:
s = "illegal operand";
break;
#endif
#ifdef ILL_ILLADR
case ILL_ILLADR:
s = "illegal addressing mode";
break;
#endif
#ifdef ILL_ILLTRP
case ILL_ILLTRP:
s = "illegal trap";
break;
#endif
#ifdef ILL_COPROC
case ILL_COPROC:
s = "coprocessor error";
break;
#endif
default:
s = "unknown";
break;
}
} else if(signum == SIGBUS)
switch(ip->si_code) {
#ifdef BUS_ADRALN
case BUS_ADRALN:
s = "invalid alignment";
break;
#endif
#ifdef BUS_ADRERR /* not on MacOS X, apparently */
case BUS_ADRERR:
s = "non-existent physical address";
break;
#endif
#ifdef BUS_OBJERR /* not on MacOS X, apparently */
case BUS_OBJERR:
s = "object specific hardware error";
break;
#endif
default:
s = "unknown";
break;
}
else
switch(ip->si_code) {
#ifdef SEGV_MAPERR
case SEGV_MAPERR:
s = "memory not mapped";
break;
#endif
#ifdef SEGV_ACCERR
case SEGV_ACCERR:
s = "invalid permissions";
break;
#endif
default:
s = "unknown";
break;
}
REprintf("address %p, cause '%s'\n", ip->si_addr, s);
}
{ /* A simple customized print of the traceback */
SEXP trace, p, q;
int line = 1, i;
PROTECT(trace = R_GetTraceback(0));
if(trace != R_NilValue) {
REprintf("\nTraceback:\n");
for(p = trace; p != R_NilValue; p = CDR(p), line++) {
q = CAR(p); /* a character vector */
REprintf("%2d: ", line);
for(i = 0; i < LENGTH(q); i++)
REprintf("%s", CHAR(STRING_ELT(q, i)));
REprintf("\n");
}
UNPROTECT(1);
}
}
if(R_Interactive) {
REprintf("\nPossible actions:\n1: %s\n2: %s\n3: %s\n4: %s\n",
"abort (with core dump, if enabled)",
"normal R exit",
"exit R without saving workspace",
"exit R saving workspace");
while(1) {
if(R_ReadConsole("Selection: ", ConsoleBuf, CONSOLE_BUFFER_SIZE,
0) > 0) {
if(ConsoleBuf[0] == '1') break;
if(ConsoleBuf[0] == '2') R_CleanUp(SA_DEFAULT, 0, 1);
if(ConsoleBuf[0] == '3') R_CleanUp(SA_NOSAVE, 70, 0);
if(ConsoleBuf[0] == '4') R_CleanUp(SA_SAVE, 71, 0);
}
}
}
REprintf("aborting ...\n");
R_CleanTempDir();
/* now do normal behaviour, e.g. core dump */
signal(signum, SIG_DFL);
raise(signum);
}
void quitR() {
// end_Rmainloop();
R_CleanUp();
}
