The R Project SVN R

Rev

Rev 60874 | Rev 61692 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 60874 Rev 61448
Line 30... Line 30...
30 
#include <string.h>
 30 
#include <string.h>
31 
#include <errno.h>
 31 
#include <errno.h>
32 
 
 32 
 
33 
#include <Rmath.h>
 33 
#include <Rmath.h>
34 
 
 34 
 
35 
#ifdef SUPPORT_CONVERTERS
 - 
 
36 
#include <R_ext/RConverters.h>
 - 
 
37 
#endif
 - 
 
38 
 
 - 
 
39 
 
 35 
 
40 
#ifndef max
 36 
#ifndef max
41 
#define max(a, b) ((a > b)?(a):(b))
 37 
#define max(a, b) ((a > b)?(a):(b))
42 
#endif
 38 
#endif
43 
 
 39 
 
Line 1380... Line 1376...
1380 
    int dup, naok, na, nargs, Fort;
 1376 
    int dup, naok, na, nargs, Fort;
1381 
    Rboolean havenames, copy = R_CBoundsCheck; /* options(CboundsCheck) */
 1377 
    Rboolean havenames, copy = R_CBoundsCheck; /* options(CboundsCheck) */
1382 
    DL_FUNC ofun = NULL;
 1378 
    DL_FUNC ofun = NULL;
1383 
    VarFun fun = NULL;
 1379 
    VarFun fun = NULL;
1384 
    SEXP ans, pa, s;
 1380 
    SEXP ans, pa, s;
1385 
#ifdef SUPPORT_CONVERTERS
 - 
 
1386 
    /* the post-call converters back to R objects. */
 - 
 
1387 
    R_toCConverter  *argConverters[65];
 - 
 
1388 
#endif
 - 
 
1389 
    R_RegisteredNativeSymbol symbol = {R_C_SYM, {NULL}, NULL};
 1381 
    R_RegisteredNativeSymbol symbol = {R_C_SYM, {NULL}, NULL};
1390 
    R_NativePrimitiveArgType *checkTypes = NULL;
 1382 
    R_NativePrimitiveArgType *checkTypes = NULL;
1391 
    R_NativeArgStyle *argStyles = NULL;
 1383 
    R_NativeArgStyle *argStyles = NULL;
1392 
    void *vmax;
 1384 
    void *vmax;
1393 
    char symName[MaxSymbolBytes];
 1385 
    char symName[MaxSymbolBytes];
Line 1461... Line 1453...
1461 
	s = CAR(pa);
 1453 
	s = CAR(pa);
1462 
	/* start with return value a copy of the inputs, as that is
 1454 
	/* start with return value a copy of the inputs, as that is
1463 
	   what is needed for DUP = FALSE and for non-atomic-vector inputs */
 1455 
	   what is needed for DUP = FALSE and for non-atomic-vector inputs */
1464 
	SET_VECTOR_ELT(ans, na, s);
 1456 
	SET_VECTOR_ELT(ans, na, s);
1465 
 
 1457 
 
1466 
#ifdef SUPPORT_CONVERTERS
 - 
 
1467 
	/* We could simplify this code, but we have no known examples */
 - 
 
1468 
	R_toCConverter **converter = argConverters + na;
 - 
 
1469 
	if(converter) *converter = NULL;
 - 
 
1470 
	if(length(getAttrib(s, R_ClassSymbol))) {
 - 
 
1471 
	    R_CConvertInfo info;
 - 
 
1472 
	    int success;
 - 
 
1473 
	    void *ans;
 - 
 
1474 
 
 - 
 
1475 
	    info.naok = naok;
 - 
 
1476 
	    info.dup = dup;
 - 
 
1477 
	    info.narg = na + 1;
 - 
 
1478 
	    info.Fort = Fort;
 - 
 
1479 
	    info.name = symName;
 - 
 
1480 
 
 - 
 
1481 
	    ans = Rf_convertToC(s, &info, &success, converter);
 - 
 
1482 
	    if(success) {
 - 
 
1483 
		cargs[na] = ans;
 - 
 
1484 
		continue;
 - 
 
1485 
	    }
 - 
 
1486 
	}
 - 
 
1487 
#endif
 - 
 
1488 
 
 - 
 
1489 
	if(checkNativeType(targetType, TYPEOF(s)) == FALSE) {
 1458 
	if(checkNativeType(targetType, TYPEOF(s)) == FALSE) {
1490 
	    if(!dup) {
 1459 
	    if(!dup) {
1491 
		error(_("explicit request not to duplicate arguments in call to '%s', but argument %d is of the wrong type (%d != %d)"),
 1460 
		error(_("explicit request not to duplicate arguments in call to '%s', but argument %d is of the wrong type (%d != %d)"),
1492 
		      symName, na + 1, targetType, TYPEOF(s));
 1461 
		      symName, na + 1, targetType, TYPEOF(s));
1493 
	    }
 1462 
	    }
Line 2296... Line 2265...
2296 
    default:
 2265 
    default:
2297 
	errorcall(call, _("too many arguments, sorry"));
 2266 
	errorcall(call, _("too many arguments, sorry"));
2298 
    }
 2267 
    }
2299 
 
 2268 
 
2300 
    if (dup) {
 2269 
    if (dup) {
2301 
#ifdef SUPPORT_CONVERTERS
 - 
 
2302 
	R_FromCConvertInfo info;
 - 
 
2303 
	info.cargs = cargs;
 - 
 
2304 
	info.allArgs = args;
 - 
 
2305 
	info.nargs = nargs;
 - 
 
2306 
	info.functionName = symName;
 - 
 
2307 
#endif
 - 
 
2308 
 
 2270 
 
2309 
	for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
 2271 
	for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
2310 
	    if(argStyles && argStyles[na] == R_ARG_IN) {
 2272 
	    if(argStyles && argStyles[na] == R_ARG_IN) {
2311 
		SET_VECTOR_ELT(ans, na, R_NilValue);
 2273 
		SET_VECTOR_ELT(ans, na, R_NilValue);
2312 
		continue;
 2274 
		continue;
2313 
#ifdef SUPPORT_CONVERTERS
 - 
 
2314 
	    } else if(argConverters[na]) {
 - 
 
2315 
		if(argConverters[na]->reverse) {
 - 
 
2316 
		    info.argIndex = na;
 - 
 
2317 
		    s = argConverters[na]->reverse(cargs[na], CAR(pa),
 - 
 
2318 
						   &info,
 - 
 
2319 
						   argConverters[na]);
 - 
 
2320 
		    PROTECT(s);
 - 
 
2321 
		    SET_VECTOR_ELT(ans, na, s);
 - 
 
2322 
		    UNPROTECT(1);
 - 
 
2323 
		} else {
 - 
 
2324 
		    SET_VECTOR_ELT(ans, na, R_NilValue);
 - 
 
2325 
		    continue;
 - 
 
2326 
		}
 - 
 
2327 
#endif
 - 
 
2328 
	    } else {
 2275 
	    } else {
2329 
		void *p = cargs[na];
 2276 
		void *p = cargs[na];
2330 
		SEXP arg = CAR(pa);
 2277 
		SEXP arg = CAR(pa);
2331 
		s = VECTOR_ELT(ans, na);
 2278 
		s = VECTOR_ELT(ans, na);
2332 
		R_NativePrimitiveArgType type =
 2279 
		R_NativePrimitiveArgType type =