The R Project SVN – R – Diff – /trunk/src/main/dotcode.c



	/* 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");

		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 (dup && 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);

		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 (dup && 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

		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 (dup && 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

		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 (dup && 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

The R Project SVN R

(root)/trunk/src/main/dotcode.c @ 63243 – Rev 64656 → 65019

Rev 64656		Rev 65019
Line 1484...		Line 1484...
1484	`/* We create any copies needed for the return value here,`	1484	`/* We create any copies needed for the return value here,`
1485	`except for character vectors. The compiled code works on`	1485	`except for character vectors. The compiled code works on`
1486	`the data pointer of the return value for the other atomic`	1486	`the data pointer of the return value for the other atomic`
1487	`vectors, and anything else is supposed to be read-only.`	1487	`vectors, and anything else is supposed to be read-only.`
1488		1488
1489	`We do not need to copy if the inputs have NAMED = 0 */`	1489	`We do not need to copy if the inputs have no references */`
1490		1490
1491	`#ifdef LONG_VECTOR_SUPPORT`	1491	`#ifdef LONG_VECTOR_SUPPORT`
1492	`if (isVector(s) && IS_LONG_VEC(s))`	1492	`if (isVector(s) && IS_LONG_VEC(s))`
1493	`error(_("long vectors (argument %d) are not supported in %s"),`	1493	`error(_("long vectors (argument %d) are not supported in %s"),`
1494	`na + 1, Fort ? ".C" : ".Fortran");`	1494	`na + 1, Fort ? ".C" : ".Fortran");`
Line 1501...		Line 1501...
1501	`char ptr = R_alloc(n sizeof(Rbyte) + 2 * NG, 1);`	1501	`char ptr = R_alloc(n sizeof(Rbyte) + 2 * NG, 1);`
1502	`memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);`	1502	`memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);`
1503	`ptr += NG;`	1503	`ptr += NG;`
1504	`memcpy(ptr, RAW(s), n);`	1504	`memcpy(ptr, RAW(s), n);`
1505	`cargs[na] = (void *) ptr;`	1505	`cargs[na] = (void *) ptr;`
1506	`} else if (dup && NAMED(s)) {`	1506	`} else if (dup && MAYBE_REFERENCED(s)) {`
1507	`n = XLENGTH(s);`	1507	`n = XLENGTH(s);`
1508	`SEXP ss = allocVector(t, n);`	1508	`SEXP ss = allocVector(t, n);`
1509	`memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));`	1509	`memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));`
1510	`SET_VECTOR_ELT(ans, na, ss);`	1510	`SET_VECTOR_ELT(ans, na, ss);`
1511	`cargs[na] = (void*) RAW(ss);`	1511	`cargs[na] = (void*) RAW(ss);`
Line 1526...		Line 1526...
1526	`char ptr = R_alloc(n sizeof(int) + 2 * NG, 1);`	1526	`char ptr = R_alloc(n sizeof(int) + 2 * NG, 1);`
1527	`memset(ptr, FILL, n * sizeof(int) + 2 * NG);`	1527	`memset(ptr, FILL, n * sizeof(int) + 2 * NG);`
1528	`ptr += NG;`	1528	`ptr += NG;`
1529	`memcpy(ptr, INTEGER(s), n * sizeof(int));`	1529	`memcpy(ptr, INTEGER(s), n * sizeof(int));`
1530	`cargs[na] = (void*) ptr;`	1530	`cargs[na] = (void*) ptr;`
1531	`} else if (dup && NAMED(s)) {`	1531	`} else if (dup && MAYBE_REFERENCED(s)) {`
1532	`SEXP ss = allocVector(t, n);`	1532	`SEXP ss = allocVector(t, n);`
1533	`memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));`	1533	`memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));`
1534	`SET_VECTOR_ELT(ans, na, ss);`	1534	`SET_VECTOR_ELT(ans, na, ss);`
1535	`cargs[na] = (void*) INTEGER(ss);`	1535	`cargs[na] = (void*) INTEGER(ss);`
1536	`#ifdef R_MEMORY_PROFILING`	1536	`#ifdef R_MEMORY_PROFILING`
Line 1557...		Line 1557...
1557	`char ptr = R_alloc(n sizeof(double) + 2 * NG, 1);`	1557	`char ptr = R_alloc(n sizeof(double) + 2 * NG, 1);`
1558	`memset(ptr, FILL, n * sizeof(double) + 2 * NG);`	1558	`memset(ptr, FILL, n * sizeof(double) + 2 * NG);`
1559	`ptr += NG;`	1559	`ptr += NG;`
1560	`memcpy(ptr, REAL(s), n * sizeof(double));`	1560	`memcpy(ptr, REAL(s), n * sizeof(double));`
1561	`cargs[na] = (void*) ptr;`	1561	`cargs[na] = (void*) ptr;`
1562	`} else if (dup && NAMED(s)) {`	1562	`} else if (dup && MAYBE_REFERENCED(s)) {`
1563	`SEXP ss = allocVector(t, n);`	1563	`SEXP ss = allocVector(t, n);`
1564	`memcpy(REAL(ss), REAL(s), n * sizeof(double));`	1564	`memcpy(REAL(ss), REAL(s), n * sizeof(double));`
1565	`SET_VECTOR_ELT(ans, na, ss);`	1565	`SET_VECTOR_ELT(ans, na, ss);`
1566	`cargs[na] = (void*) REAL(ss);`	1566	`cargs[na] = (void*) REAL(ss);`
1567	`#ifdef R_MEMORY_PROFILING`	1567	`#ifdef R_MEMORY_PROFILING`
Line 1580...		Line 1580...
1580	`char ptr = R_alloc(n sizeof(Rcomplex) + 2 * NG, 1);`	1580	`char ptr = R_alloc(n sizeof(Rcomplex) + 2 * NG, 1);`
1581	`memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);`	1581	`memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);`
1582	`ptr += NG;`	1582	`ptr += NG;`
1583	`memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));`	1583	`memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));`
1584	`cargs[na] = (void*) ptr;`	1584	`cargs[na] = (void*) ptr;`
1585	`} else if (dup && NAMED(s)) {`	1585	`} else if (dup && MAYBE_REFERENCED(s)) {`
1586	`SEXP ss = allocVector(t, n);`	1586	`SEXP ss = allocVector(t, n);`
1587	`memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));`	1587	`memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));`
1588	`SET_VECTOR_ELT(ans, na, ss);`	1588	`SET_VECTOR_ELT(ans, na, ss);`
1589	`cargs[na] = (void*) COMPLEX(ss);`	1589	`cargs[na] = (void*) COMPLEX(ss);`
1590	`#ifdef R_MEMORY_PROFILING`	1590	`#ifdef R_MEMORY_PROFILING`