Permalink
Browse files

merge do_getenv and do_interactive

git-svn-id: https://svn.r-project.org/R/trunk@6121 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information...
ripley
ripley committed Oct 10, 1999
1 parent 189c6ae commit 1b21273ef5c8343cdc0e18968b6b6fc980c8c8f0
Showing with 65 additions and 95 deletions.
  1. +2 −47 src/gnuwin32/sys-win32.c
  2. +0 −1 src/include/Rdefines.h
  3. +63 −0 src/unix/sys-common.c
  4. +0 −47 src/unix/sys-unix.c
View
@@ -95,58 +95,13 @@ char *R_ExpandFileName(char *s)
* 7) PLATFORM DEPENDENT FUNCTIONS
*/
#include <windows.h>
SEXP do_getenv(SEXP call, SEXP op, SEXP args, SEXP env)
{
int i, j;
char *s;
char *e;
SEXP ans;
char *envir;
checkArity(op, args);
if (!isString(CAR(args)))
errorcall(call, "wrong type for argument");
i = LENGTH(CAR(args));
if (i == 0) {
envir = (char *) GetEnvironmentStrings();
for (i = 0, e = envir; strlen(e) > 0; i++, e += strlen(e)+1);
PROTECT(ans = allocVector(STRSXP, i));
for (i = 0, e = envir; strlen(e) > 0; i++, e += strlen(e)+1) {
STRING(ans)[i] = mkChar(e);
}
FreeEnvironmentStrings(envir);
} else {
PROTECT(ans = allocVector(STRSXP, i));
for (j = 0; j < i; j++) {
s = getenv(CHAR(STRING(CAR(args))[j]));
if (s == NULL)
STRING(ans)[j] = mkChar("");
else
STRING(ans)[j] = mkChar(s);
}
}
UNPROTECT(1);
return (ans);
}
SEXP do_interactive(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP rval;
rval = allocVector(LGLSXP, 1);
LOGICAL(rval)[0] = R_Interactive;
return rval;
}
SEXP do_machine(SEXP call, SEXP op, SEXP args, SEXP env)
{
return mkString("Win32");
}
#include <windows.h>
#ifdef HAVE_TIMES
static DWORD StartTime;
View
@@ -107,7 +107,6 @@
#define Memcpy(p,q,n) memcpy( p, q, (size_t)( (n) * sizeof(*p) ) )
/* S Like Fortran Interface */
/* These may not be adequate everywhere. Convex had _ prepending common
blocks, and some compilers may need to specify Fortran linkage */
View
@@ -181,6 +181,69 @@ char *R_HomeDir()
return getenv("R_HOME");
}
/*
* 7) PLATFORM DEPENDENT FUNCTIONS
*/
#ifdef Win32
#include <windows.h>
#else
extern char ** environ;
#endif
SEXP do_getenv(SEXP call, SEXP op, SEXP args, SEXP env)
{
int i, j;
char *s;
SEXP ans;
checkArity(op, args);
if (!isString(CAR(args)))
errorcall(call, "wrong type for argument");
i = LENGTH(CAR(args));
if (i == 0) {
#ifdef Win32
char *envir, *e;
envir = (char *) GetEnvironmentStrings();
for (i = 0, e = envir; strlen(e) > 0; i++, e += strlen(e)+1);
PROTECT(ans = allocVector(STRSXP, i));
for (i = 0, e = envir; strlen(e) > 0; i++, e += strlen(e)+1)
STRING(ans)[i] = mkChar(e);
FreeEnvironmentStrings(envir);
#else
char **e;
for (i = 0, e = environ; *e != NULL; i++, e++);
PROTECT(ans = allocVector(STRSXP, i));
for (i = 0, e = environ; *e != NULL; i++, e++)
STRING(ans)[i] = mkChar(*e);
#endif
} else {
PROTECT(ans = allocVector(STRSXP, i));
for (j = 0; j < i; j++) {
s = getenv(CHAR(STRING(CAR(args))[j]));
if (s == NULL)
STRING(ans)[j] = mkChar("");
else
STRING(ans)[j] = mkChar(s);
}
}
UNPROTECT(1);
return (ans);
}
SEXP do_interactive(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP rval;
rval=allocVector(LGLSXP, 1);
if( R_Interactive )
LOGICAL(rval)[0]=1;
else
LOGICAL(rval)[0]=0;
return rval;
}
/*
* INITIALIZATION HELPER CODE
View
@@ -115,53 +115,6 @@ FILE *R_OpenInitFile(void)
* 7) PLATFORM DEPENDENT FUNCTIONS
*/
extern char ** environ;
SEXP do_getenv(SEXP call, SEXP op, SEXP args, SEXP env)
{
int i, j;
char *s;
char **e;
SEXP ans;
checkArity(op, args);
if (!isString(CAR(args)))
errorcall(call, "wrong type for argument");
i = LENGTH(CAR(args));
if (i == 0) {
for (i = 0, e = environ; *e != NULL; i++, e++);
PROTECT(ans = allocVector(STRSXP, i));
for (i = 0, e = environ; *e != NULL; i++, e++)
STRING(ans)[i] = mkChar(*e);
} else {
PROTECT(ans = allocVector(STRSXP, i));
for (j = 0; j < i; j++) {
s = getenv(CHAR(STRING(CAR(args))[j]));
if (s == NULL)
STRING(ans)[j] = mkChar("");
else
STRING(ans)[j] = mkChar(s);
}
}
UNPROTECT(1);
return (ans);
}
SEXP do_interactive(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP rval;
rval=allocVector(LGLSXP, 1);
if( R_Interactive )
LOGICAL(rval)[0]=1;
else
LOGICAL(rval)[0]=0;
return rval;
}
SEXP do_machine(SEXP call, SEXP op, SEXP args, SEXP env)
{
return mkString("Unix");

0 comments on commit 1b21273

Please sign in to comment.