in source/src/main/dotcode.c [1406:2484]
SEXP attribute_hidden do_dotCode(SEXP call, SEXP op, SEXP args, SEXP env)
{
void **cargs, **cargs0 = NULL /* -Wall */;
int naok, na, nargs, Fort;
Rboolean havenames, copy = R_CBoundsCheck; /* options(CboundsCheck) */
DL_FUNC ofun = NULL;
VarFun fun = NULL;
SEXP ans, pa, s;
R_RegisteredNativeSymbol symbol = {R_C_SYM, {NULL}, NULL};
R_NativePrimitiveArgType *checkTypes = NULL;
R_NativeArgStyle *argStyles = NULL;
const void *vmax;
char symName[MaxSymbolBytes];
if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
check1arg2(args, call, ".NAME");
if (NaokSymbol == NULL || DupSymbol == NULL || PkgSymbol == NULL) {
NaokSymbol = install("NAOK");
DupSymbol = install("DUP");
PkgSymbol = install("PACKAGE");
}
if (EncSymbol == NULL) EncSymbol = install("ENCODING");
if (CSingSymbol == NULL) CSingSymbol = install("Csingle");
vmax = vmaxget();
Fort = PRIMVAL(op);
if(Fort) symbol.type = R_FORTRAN_SYM;
args = enctrim(args);
args = resolveNativeRoutine(args, &ofun, &symbol, symName, &nargs,
&naok, call, env);
fun = (VarFun) ofun;
if(symbol.symbol.c && symbol.symbol.c->numArgs > -1) {
if(symbol.symbol.c->numArgs != nargs)
errorcall(call,
_("Incorrect number of arguments (%d), expecting %d for '%s'"),
nargs, symbol.symbol.c->numArgs, symName);
checkTypes = symbol.symbol.c->types;
argStyles = symbol.symbol.c->styles;
}
/* Construct the return value */
nargs = 0;
havenames = FALSE;
for(pa = args ; pa != R_NilValue; pa = CDR(pa)) {
if (TAG(pa) != R_NilValue) havenames = TRUE;
nargs++;
}
PROTECT(ans = allocVector(VECSXP, nargs));
if (havenames) {
SEXP names;
PROTECT(names = allocVector(STRSXP, nargs));
for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
if (TAG(pa) == R_NilValue)
SET_STRING_ELT(names, na, R_BlankString);
else
SET_STRING_ELT(names, na, PRINTNAME(TAG(pa)));
}
setAttrib(ans, R_NamesSymbol, names);
UNPROTECT(1);
}
/* Convert the arguments for use in foreign function calls. */
cargs = (void**) R_alloc(nargs, sizeof(void*));
if (copy) cargs0 = (void**) R_alloc(nargs, sizeof(void*));
for(na = 0, pa = args ; pa != R_NilValue; pa = CDR(pa), na++) {
if(checkTypes &&
!comparePrimitiveTypes(checkTypes[na], CAR(pa))) {
/* We can loop over all the arguments and report all the
erroneous ones, but then we would also want to avoid
the conversions. Also, in the future, we may just
attempt to coerce the value to the appropriate
type. */
errorcall(call, _("wrong type for argument %d in call to %s"),
na+1, symName);
}
int nprotect = 0, targetType = checkTypes ? checkTypes[na] : 0;
R_xlen_t n;
s = CAR(pa);
/* start with return value a copy of the inputs, as that is
what is needed for non-atomic-vector inputs */
SET_VECTOR_ELT(ans, na, s);
if(checkNativeType(targetType, TYPEOF(s)) == FALSE &&
targetType != SINGLESXP) {
/* Cannot be called if DUP = FALSE, so only needs to live
until copied in the switch.
But R_alloc allocates, so missed protection < R 2.15.0.
*/
PROTECT(s = coerceVector(s, targetType));
nprotect++;
}
/* We create any copies needed for the return value here,
except for character vectors. The compiled code works on
the data pointer of the return value for the other atomic
vectors, and anything else is supposed to be read-only.
We do not need to copy if the inputs have no references */
#ifdef LONG_VECTOR_SUPPORT
if (isVector(s) && IS_LONG_VEC(s))
error(_("long vectors (argument %d) are not supported in %s"),
na + 1, Fort ? ".C" : ".Fortran");
#endif
SEXPTYPE t = TYPEOF(s);
switch(t) {
case RAWSXP:
if (copy) {
n = XLENGTH(s);
char *ptr = R_alloc(n * sizeof(Rbyte) + 2 * NG, 1);
memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);
ptr += NG;
memcpy(ptr, RAW(s), n);
cargs[na] = (void *) ptr;
} else if (MAYBE_REFERENCED(s)) {
n = XLENGTH(s);
SEXP ss = allocVector(t, n);
memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));
SET_VECTOR_ELT(ans, na, ss);
cargs[na] = (void*) RAW(ss);
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, ss);
#endif
} else cargs[na] = (void *) RAW(s);
break;
case LGLSXP:
case INTSXP:
n = XLENGTH(s);
int *iptr = INTEGER(s);
if (!naok)
for (R_xlen_t i = 0 ; i < n ; i++)
if(iptr[i] == NA_INTEGER)
error(_("NAs in foreign function call (arg %d)"), na + 1);
if (copy) {
char *ptr = R_alloc(n * sizeof(int) + 2 * NG, 1);
memset(ptr, FILL, n * sizeof(int) + 2 * NG);
ptr += NG;
memcpy(ptr, INTEGER(s), n * sizeof(int));
cargs[na] = (void*) ptr;
} else if (MAYBE_REFERENCED(s)) {
SEXP ss = allocVector(t, n);
memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));
SET_VECTOR_ELT(ans, na, ss);
cargs[na] = (void*) INTEGER(ss);
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, ss);
#endif
} else cargs[na] = (void*) iptr;
break;
case REALSXP:
n = XLENGTH(s);
double *rptr = REAL(s);
if (!naok)
for (R_xlen_t i = 0 ; i < n ; i++)
if(!R_FINITE(rptr[i]))
error(_("NA/NaN/Inf in foreign function call (arg %d)"), na + 1);
if (asLogical(getAttrib(s, CSingSymbol)) == 1) {
float *sptr = (float*) R_alloc(n, sizeof(float));
for (R_xlen_t i = 0 ; i < n ; i++) sptr[i] = (float) REAL(s)[i];
cargs[na] = (void*) sptr;
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, sptr);
#endif
} else if (copy) {
char *ptr = R_alloc(n * sizeof(double) + 2 * NG, 1);
memset(ptr, FILL, n * sizeof(double) + 2 * NG);
ptr += NG;
memcpy(ptr, REAL(s), n * sizeof(double));
cargs[na] = (void*) ptr;
} else if (MAYBE_REFERENCED(s)) {
SEXP ss = allocVector(t, n);
memcpy(REAL(ss), REAL(s), n * sizeof(double));
SET_VECTOR_ELT(ans, na, ss);
cargs[na] = (void*) REAL(ss);
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, ss);
#endif
} else cargs[na] = (void*) rptr;
break;
case CPLXSXP:
n = XLENGTH(s);
Rcomplex *zptr = COMPLEX(s);
if (!naok)
for (R_xlen_t i = 0 ; i < n ; i++)
if(!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i))
error(_("complex NA/NaN/Inf in foreign function call (arg %d)"), na + 1);
if (copy) {
char *ptr = R_alloc(n * sizeof(Rcomplex) + 2 * NG, 1);
memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);
ptr += NG;
memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));
cargs[na] = (void*) ptr;
} else if (MAYBE_REFERENCED(s)) {
SEXP ss = allocVector(t, n);
memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));
SET_VECTOR_ELT(ans, na, ss);
cargs[na] = (void*) COMPLEX(ss);
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, ss);
#endif
} else cargs[na] = (void *) zptr;
break;
case STRSXP:
n = XLENGTH(s);
if (Fort) {
const char *ss = translateChar(STRING_ELT(s, 0));
if (n > 1)
warning(_("only first string in char vector used in .Fortran"));
char *fptr = (char*) R_alloc(max(255, strlen(ss)) + 1, sizeof(char));
strcpy(fptr, ss);
cargs[na] = (void*) fptr;
} else if (copy) {
char **cptr = (char**) R_alloc(n, sizeof(char*)),
**cptr0 = (char**) R_alloc(n, sizeof(char*));
for (R_xlen_t i = 0 ; i < n ; i++) {
const char *ss = translateChar(STRING_ELT(s, i));
size_t nn = strlen(ss) + 1 + 2 * NG;
char *ptr = (char*) R_alloc(nn, sizeof(char));
memset(ptr, FILL, nn);
cptr[i] = cptr0[i] = ptr + NG;
strcpy(cptr[i], ss);
}
cargs[na] = (void*) cptr;
cargs0[na] = (void*) cptr0;
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, cargs[na]);
#endif
} else {
char **cptr = (char**) R_alloc(n, sizeof(char*));
for (R_xlen_t i = 0 ; i < n ; i++) {
const char *ss = translateChar(STRING_ELT(s, i));
size_t nn = strlen(ss) + 1;
if(nn > 1) {
cptr[i] = (char*) R_alloc(nn, sizeof(char));
strcpy(cptr[i], ss);
} else {
/* Protect ourselves against those who like to
extend "", maybe using strncpy */
nn = 128;
cptr[i] = (char*) R_alloc(nn, sizeof(char));
memset(cptr[i], 0, nn);
}
}
cargs[na] = (void*) cptr;
#ifdef R_MEMORY_PROFILING
if (RTRACE(s)) memtrace_report(s, cargs[na]);
#endif
}
break;
case VECSXP:
if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
type2char(t), na + 1);
/* Used read-only, so this is safe */
#ifdef USE_RINTERNALS
cargs[na] = (void*) DATAPTR(s);
#else
n = XLENGTH(s);
SEXP *lptr = (SEXP *) R_alloc(n, sizeof(SEXP));
for (R_xlen_t i = 0 ; i < n ; i++) lptr[i] = VECTOR_ELT(s, i);
cargs[na] = (void*) lptr;
#endif
break;
case CLOSXP:
case BUILTINSXP:
case SPECIALSXP:
case ENVSXP:
if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
type2char(t), na + 1);
cargs[na] = (void*) s;
break;
case NILSXP:
error(_("invalid mode (%s) to pass to C or Fortran (arg %d)"),
type2char(t), na + 1);
cargs[na] = (void*) s;
break;
default:
/* Includes pairlists from R 2.15.0 */
if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
type2char(t), na + 1);
warning("passing an object of type '%s' to .C (arg %d) is deprecated",
type2char(t), na + 1);
if (t == LISTSXP)
warning(_("pairlists are passed as SEXP as from R 2.15.0"));
cargs[na] = (void*) s;
break;
}
if (nprotect) UNPROTECT(nprotect);
}
switch (nargs) {
case 0:
/* Silicon graphics C chokes here */
/* if there is no argument to fun. */
fun(0);
break;
case 1:
fun(cargs[0]);
break;
case 2:
fun(cargs[0], cargs[1]);
break;
case 3:
fun(cargs[0], cargs[1], cargs[2]);
break;
case 4:
fun(cargs[0], cargs[1], cargs[2], cargs[3]);
break;
case 5:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4]);
break;
case 6:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5]);
break;
case 7:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6]);
break;
case 8:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7]);
break;
case 9:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8]);
break;
case 10:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9]);
break;
case 11:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10]);
break;
case 12:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11]);
break;
case 13:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12]);
break;
case 14:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13]);
break;
case 15:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14]);
break;
case 16:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15]);
break;
case 17:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16]);
break;
case 18:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17]);
break;
case 19:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18]);
break;
case 20:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19]);
break;
case 21:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20]);
break;
case 22:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21]);
break;
case 23:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22]);
break;
case 24:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23]);
break;
case 25:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24]);
break;
case 26:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25]);
break;
case 27:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26]);
break;
case 28:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27]);
break;
case 29:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28]);
break;
case 30:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29]);
break;
case 31:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30]);
break;
case 32:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31]);
break;
case 33:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32]);
break;
case 34:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33]);
break;
case 35:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34]);
break;
case 36:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35]);
break;
case 37:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36]);
break;
case 38:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37]);
break;
case 39:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38]);
break;
case 40:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39]);
break;
case 41:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40]);
break;
case 42:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41]);
break;
case 43:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42]);
break;
case 44:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43]);
break;
case 45:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44]);
break;
case 46:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45]);
break;
case 47:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46]);
break;
case 48:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47]);
break;
case 49:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48]);
break;
case 50:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49]);
break;
case 51:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50]);
break;
case 52:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51]);
break;
case 53:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52]);
break;
case 54:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53]);
break;
case 55:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54]);
break;
case 56:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55]);
break;
case 57:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56]);
break;
case 58:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57]);
break;
case 59:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58]);
break;
case 60:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59]);
break;
case 61:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
cargs[60]);
break;
case 62:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
cargs[60], cargs[61]);
break;
case 63:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
cargs[60], cargs[61], cargs[62]);
break;
case 64:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
cargs[60], cargs[61], cargs[62], cargs[63]);
break;
case 65:
fun(cargs[0], cargs[1], cargs[2], cargs[3], cargs[4],
cargs[5], cargs[6], cargs[7], cargs[8], cargs[9],
cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
cargs[60], cargs[61], cargs[62], cargs[63], cargs[64]);
break;
default:
errorcall(call, _("too many arguments, sorry"));
}
for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
if(argStyles && argStyles[na] == R_ARG_IN) {
SET_VECTOR_ELT(ans, na, R_NilValue);
continue;
} else {
void *p = cargs[na];
SEXP arg = CAR(pa);
s = VECTOR_ELT(ans, na);
R_NativePrimitiveArgType type =
checkTypes ? checkTypes[na] : TYPEOF(arg);
R_xlen_t n = xlength(arg);
switch(type) {
case RAWSXP:
if (copy) {
s = allocVector(type, n);
unsigned char *ptr = (unsigned char *) p;
memcpy(RAW(s), ptr, n * sizeof(Rbyte));
ptr += n * sizeof(Rbyte);
for (int i = 0; i < NG; i++)
if(*ptr++ != FILL)
error("array over-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
ptr = (unsigned char *) p;
for (int i = 0; i < NG; i++)
if(*--ptr != FILL)
error("array under-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
}
break;
case INTSXP:
if (copy) {
s = allocVector(type, n);
unsigned char *ptr = (unsigned char *) p;
memcpy(INTEGER(s), ptr, n * sizeof(int));
ptr += n * sizeof(int);
for (int i = 0; i < NG; i++)
if(*ptr++ != FILL)
error("array over-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
ptr = (unsigned char *) p;
for (int i = 0; i < NG; i++)
if(*--ptr != FILL)
error("array under-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
}
break;
case LGLSXP:
if (copy) {
s = allocVector(type, n);
unsigned char *ptr = (unsigned char *) p;
int *iptr = (int*) ptr, tmp;
for (R_xlen_t i = 0 ; i < n ; i++) {
tmp = iptr[i];
LOGICAL(s)[i] = (tmp == NA_INTEGER || tmp == 0) ? tmp : 1;
}
ptr += n * sizeof(int);
for (int i = 0; i < NG; i++)
if(*ptr++ != FILL)
error("array over-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
ptr = (unsigned char *) p;
for (int i = 0; i < NG; i++)
if(*--ptr != FILL)
error("array under-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
} else {
int *iptr = INTEGER(arg), tmp;
for (R_xlen_t i = 0 ; i < n ; i++) {
tmp = iptr[i];
iptr[i] = (tmp == NA_INTEGER || tmp == 0) ? tmp : 1;
}
}
break;
case REALSXP:
case SINGLESXP:
if (copy) {
s = allocVector(REALSXP, n);
if (type == SINGLESXP || asLogical(getAttrib(arg, CSingSymbol)) == 1) {
float *sptr = (float*) p;
for(R_xlen_t i = 0 ; i < n ; i++)
REAL(s)[i] = (double) sptr[i];
} else {
unsigned char *ptr = (unsigned char *) p;
memcpy(REAL(s), ptr, n * sizeof(double));
ptr += n * sizeof(double);
for (int i = 0; i < NG; i++)
if(*ptr++ != FILL)
error("array over-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
ptr = (unsigned char *) p;
for (int i = 0; i < NG; i++)
if(*--ptr != FILL)
error("array under-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
}
} else {
if (type == SINGLESXP || asLogical(getAttrib(arg, CSingSymbol)) == 1) {
s = allocVector(REALSXP, n);
float *sptr = (float*) p;
for(int i = 0 ; i < n ; i++)
REAL(s)[i] = (double) sptr[i];
}
}
break;
case CPLXSXP:
if (copy) {
s = allocVector(type, n);
unsigned char *ptr = (unsigned char *) p;
memcpy(COMPLEX(s), p, n * sizeof(Rcomplex));
ptr += n * sizeof(Rcomplex);
for (int i = 0; i < NG; i++)
if(*ptr++ != FILL)
error("array over-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
ptr = (unsigned char *) p;
for (int i = 0; i < NG; i++)
if(*--ptr != FILL)
error("array under-run in %s(\"%s\") in %s argument %d\n",
Fort ? ".Fortran" : ".C",
symName, type2char(type), na+1);
}
break;
case STRSXP:
if(Fort) {
char buf[256];
/* only return one string: warned on the R -> Fortran step */
strncpy(buf, (char*)p, 255);
buf[255] = '\0';
PROTECT(s = allocVector(type, 1));
SET_STRING_ELT(s, 0, mkChar(buf));
UNPROTECT(1);
} else if (copy) {
SEXP ss = arg;
PROTECT(s = allocVector(type, n));
char **cptr = (char**) p, **cptr0 = (char**) cargs0[na];
for (R_xlen_t i = 0 ; i < n ; i++) {
unsigned char *ptr = (unsigned char *) cptr[i];
SET_STRING_ELT(s, i, mkChar(cptr[i]));
if (cptr[i] == cptr0[i]) {
const char *z = translateChar(STRING_ELT(ss, i));
for (int j = 0; j < NG; j++)
if(*--ptr != FILL)
error("array under-run in .C(\"%s\") in character argument %d, element %d",
symName, na+1, (int)(i+1));
ptr = (unsigned char *) cptr[i];
ptr += strlen(z) + 1;
for (int j = 0; j < NG; j++)
if(*ptr++ != FILL) {
// force termination
unsigned char *p = ptr;
for (int k = 1; k < NG - j; k++, p++)
if (*p == FILL) *p = '\0';
error("array over-run in .C(\"%s\") in character argument %d, element %d\n'%s'->'%s'\n",
symName, na+1, (int)(i+1),
z, cptr[i]);
}
}
}
UNPROTECT(1);
} else {
PROTECT(s = allocVector(type, n));
char **cptr = (char**) p;
for (R_xlen_t i = 0 ; i < n ; i++)
SET_STRING_ELT(s, i, mkChar(cptr[i]));
UNPROTECT(1);
}
break;
default:
break;
}
if (s != arg) {
PROTECT(s);
SHALLOW_DUPLICATE_ATTRIB(s, arg);
SET_VECTOR_ELT(ans, na, s);
UNPROTECT(1);
}
}
}
UNPROTECT(1);
vmaxset(vmax);
return ans;
}