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



	    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;
		if (n) memcpy(ptr, RAW(s), n);
		cargs[na] = (void *) ptr;
	    } else if (MAYBE_REFERENCED(s)) {
		n = XLENGTH(s);
		SEXP ss = allocVector(t, n);
		if (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

			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;
		if (n) memcpy(ptr, INTEGER(s), n * sizeof(int));
		cargs[na] = (void*) ptr;
	    } else if (MAYBE_REFERENCED(s)) {
		SEXP ss = allocVector(t, n);
		if (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

#endif
	    } else if (copy) {
		char *ptr = R_alloc(n * sizeof(double) + 2 * NG, 1);
		memset(ptr, FILL, n * sizeof(double) + 2 * NG);
		ptr += NG;
		if (n) memcpy(ptr, REAL(s), n * sizeof(double));
		cargs[na] = (void*) ptr;
	    } else if (MAYBE_REFERENCED(s)) {
		SEXP ss  = allocVector(t, n);
		if (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

			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;
		if (n) memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));
		cargs[na] = (void*) ptr;
	    } else if (MAYBE_REFERENCED(s)) {
		SEXP ss = allocVector(t, n);
		if (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

	switch(type) {
	case RAWSXP:
	    if (copy) {
		s = allocVector(type, n);
		unsigned char *ptr = (unsigned char *) p;
		if (n) 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",

	    break;
	case INTSXP:
	    if (copy) {
		s = allocVector(type, n);
		unsigned char *ptr = (unsigned char *) p;
		if (n) 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",

		    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;
		    if (n) 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",

	    break;
	case CPLXSXP:
	    if (copy) {
		s = allocVector(type, n);
		unsigned char *ptr = (unsigned char *) p;
		if (n) 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",

Rev 86452	Rev 87180
Line 1767...	Line 1767...
1767	`if (copy) {`	1767	`if (copy) {`
1768	`n = XLENGTH(s);`	1768	`n = XLENGTH(s);`
1769	`char ptr = R_alloc(n sizeof(Rbyte) + 2 * NG, 1);`	1769	`char ptr = R_alloc(n sizeof(Rbyte) + 2 * NG, 1);`
1770	`memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);`	1770	`memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);`
1771	`ptr += NG;`	1771	`ptr += NG;`
1772	`memcpy(ptr, RAW(s), n);`	1772	`if (n) memcpy(ptr, RAW(s), n);`
1773	`cargs[na] = (void *) ptr;`	1773	`cargs[na] = (void *) ptr;`
1774	`} else if (MAYBE_REFERENCED(s)) {`	1774	`} else if (MAYBE_REFERENCED(s)) {`
1775	`n = XLENGTH(s);`	1775	`n = XLENGTH(s);`
1776	`SEXP ss = allocVector(t, n);`	1776	`SEXP ss = allocVector(t, n);`
1777	`memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));`	1777	`if (n) memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));`
1778	`SET_VECTOR_ELT(ans, na, ss);`	1778	`SET_VECTOR_ELT(ans, na, ss);`
1779	`cargs[na] = (void*) RAW(ss);`	1779	`cargs[na] = (void*) RAW(ss);`
1780	`#ifdef R_MEMORY_PROFILING`	1780	`#ifdef R_MEMORY_PROFILING`
1781	`if (RTRACE(s)) memtrace_report(s, ss);`	1781	`if (RTRACE(s)) memtrace_report(s, ss);`
1782	`#endif`	1782	`#endif`
Line 1792...	Line 1792...
1792	`error(_("NAs in foreign function call (arg %d)"), na + 1);`	1792	`error(_("NAs in foreign function call (arg %d)"), na + 1);`
1793	`if (copy) {`	1793	`if (copy) {`
1794	`char ptr = R_alloc(n sizeof(int) + 2 * NG, 1);`	1794	`char ptr = R_alloc(n sizeof(int) + 2 * NG, 1);`
1795	`memset(ptr, FILL, n * sizeof(int) + 2 * NG);`	1795	`memset(ptr, FILL, n * sizeof(int) + 2 * NG);`
1796	`ptr += NG;`	1796	`ptr += NG;`
1797	`memcpy(ptr, INTEGER(s), n * sizeof(int));`	1797	`if (n) memcpy(ptr, INTEGER(s), n * sizeof(int));`
1798	`cargs[na] = (void*) ptr;`	1798	`cargs[na] = (void*) ptr;`
1799	`} else if (MAYBE_REFERENCED(s)) {`	1799	`} else if (MAYBE_REFERENCED(s)) {`
1800	`SEXP ss = allocVector(t, n);`	1800	`SEXP ss = allocVector(t, n);`
1801	`memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));`	1801	`if (n) memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));`
1802	`SET_VECTOR_ELT(ans, na, ss);`	1802	`SET_VECTOR_ELT(ans, na, ss);`
1803	`cargs[na] = (void*) INTEGER(ss);`	1803	`cargs[na] = (void*) INTEGER(ss);`
1804	`#ifdef R_MEMORY_PROFILING`	1804	`#ifdef R_MEMORY_PROFILING`
1805	`if (RTRACE(s)) memtrace_report(s, ss);`	1805	`if (RTRACE(s)) memtrace_report(s, ss);`
1806	`#endif`	1806	`#endif`
Line 1822...	Line 1822...
1822	`#endif`	1822	`#endif`
1823	`} else if (copy) {`	1823	`} else if (copy) {`
1824	`char ptr = R_alloc(n sizeof(double) + 2 * NG, 1);`	1824	`char ptr = R_alloc(n sizeof(double) + 2 * NG, 1);`
1825	`memset(ptr, FILL, n * sizeof(double) + 2 * NG);`	1825	`memset(ptr, FILL, n * sizeof(double) + 2 * NG);`
1826	`ptr += NG;`	1826	`ptr += NG;`
1827	`memcpy(ptr, REAL(s), n * sizeof(double));`	1827	`if (n) memcpy(ptr, REAL(s), n * sizeof(double));`
1828	`cargs[na] = (void*) ptr;`	1828	`cargs[na] = (void*) ptr;`
1829	`} else if (MAYBE_REFERENCED(s)) {`	1829	`} else if (MAYBE_REFERENCED(s)) {`
1830	`SEXP ss = allocVector(t, n);`	1830	`SEXP ss = allocVector(t, n);`
1831	`memcpy(REAL(ss), REAL(s), n * sizeof(double));`	1831	`if (n) memcpy(REAL(ss), REAL(s), n * sizeof(double));`
1832	`SET_VECTOR_ELT(ans, na, ss);`	1832	`SET_VECTOR_ELT(ans, na, ss);`
1833	`cargs[na] = (void*) REAL(ss);`	1833	`cargs[na] = (void*) REAL(ss);`
1834	`#ifdef R_MEMORY_PROFILING`	1834	`#ifdef R_MEMORY_PROFILING`
1835	`if (RTRACE(s)) memtrace_report(s, ss);`	1835	`if (RTRACE(s)) memtrace_report(s, ss);`
1836	`#endif`	1836	`#endif`
Line 1845...	Line 1845...
1845	`error(_("complex NA/NaN/Inf in foreign function call (arg %d)"), na + 1);`	1845	`error(_("complex NA/NaN/Inf in foreign function call (arg %d)"), na + 1);`
1846	`if (copy) {`	1846	`if (copy) {`
1847	`char ptr = R_alloc(n sizeof(Rcomplex) + 2 * NG, 1);`	1847	`char ptr = R_alloc(n sizeof(Rcomplex) + 2 * NG, 1);`
1848	`memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);`	1848	`memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);`
1849	`ptr += NG;`	1849	`ptr += NG;`
1850	`memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));`	1850	`if (n) memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));`
1851	`cargs[na] = (void*) ptr;`	1851	`cargs[na] = (void*) ptr;`
1852	`} else if (MAYBE_REFERENCED(s)) {`	1852	`} else if (MAYBE_REFERENCED(s)) {`
1853	`SEXP ss = allocVector(t, n);`	1853	`SEXP ss = allocVector(t, n);`
1854	`memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));`	1854	`if (n) memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));`
1855	`SET_VECTOR_ELT(ans, na, ss);`	1855	`SET_VECTOR_ELT(ans, na, ss);`
1856	`cargs[na] = (void*) COMPLEX(ss);`	1856	`cargs[na] = (void*) COMPLEX(ss);`
1857	`#ifdef R_MEMORY_PROFILING`	1857	`#ifdef R_MEMORY_PROFILING`
1858	`if (RTRACE(s)) memtrace_report(s, ss);`	1858	`if (RTRACE(s)) memtrace_report(s, ss);`
1859	`#endif`	1859	`#endif`
Line 2559...	Line 2559...
2559	`switch(type) {`	2559	`switch(type) {`
2560	`case RAWSXP:`	2560	`case RAWSXP:`
2561	`if (copy) {`	2561	`if (copy) {`
2562	`s = allocVector(type, n);`	2562	`s = allocVector(type, n);`
2563	`unsigned char ptr = (unsigned char ) p;`	2563	`unsigned char ptr = (unsigned char ) p;`
2564	`memcpy(RAW(s), ptr, n * sizeof(Rbyte));`	2564	`if (n) memcpy(RAW(s), ptr, n * sizeof(Rbyte));`
2565	`ptr += n * sizeof(Rbyte);`	2565	`ptr += n * sizeof(Rbyte);`
2566	`for (int i = 0; i < NG; i++)`	2566	`for (int i = 0; i < NG; i++)`
2567	`if(*ptr++ != FILL)`	2567	`if(*ptr++ != FILL)`
2568	`error("array over-run in %s(\"%s\") in %s argument %d\n",`	2568	`error("array over-run in %s(\"%s\") in %s argument %d\n",`
2569	`Fort ? ".Fortran" : ".C",`	2569	`Fort ? ".Fortran" : ".C",`
Line 2578...	Line 2578...
2578	`break;`	2578	`break;`
2579	`case INTSXP:`	2579	`case INTSXP:`
2580	`if (copy) {`	2580	`if (copy) {`
2581	`s = allocVector(type, n);`	2581	`s = allocVector(type, n);`
2582	`unsigned char ptr = (unsigned char ) p;`	2582	`unsigned char ptr = (unsigned char ) p;`
2583	`memcpy(INTEGER(s), ptr, n * sizeof(int));`	2583	`if (n) memcpy(INTEGER(s), ptr, n * sizeof(int));`
2584	`ptr += n * sizeof(int);`	2584	`ptr += n * sizeof(int);`
2585	`for (int i = 0; i < NG; i++)`	2585	`for (int i = 0; i < NG; i++)`
2586	`if(*ptr++ != FILL)`	2586	`if(*ptr++ != FILL)`
2587	`error("array over-run in %s(\"%s\") in %s argument %d\n",`	2587	`error("array over-run in %s(\"%s\") in %s argument %d\n",`
2588	`Fort ? ".Fortran" : ".C",`	2588	`Fort ? ".Fortran" : ".C",`
Line 2632...	Line 2632...
2632	`float sptr = (float) p;`	2632	`float sptr = (float) p;`
2633	`for(R_xlen_t i = 0 ; i < n ; i++)`	2633	`for(R_xlen_t i = 0 ; i < n ; i++)`
2634	`REAL(s)[i] = (double) sptr[i];`	2634	`REAL(s)[i] = (double) sptr[i];`
2635	`} else {`	2635	`} else {`
2636	`unsigned char ptr = (unsigned char ) p;`	2636	`unsigned char ptr = (unsigned char ) p;`
2637	`memcpy(REAL(s), ptr, n * sizeof(double));`	2637	`if (n) memcpy(REAL(s), ptr, n * sizeof(double));`
2638	`ptr += n * sizeof(double);`	2638	`ptr += n * sizeof(double);`
2639	`for (int i = 0; i < NG; i++)`	2639	`for (int i = 0; i < NG; i++)`
2640	`if(*ptr++ != FILL)`	2640	`if(*ptr++ != FILL)`
2641	`error("array over-run in %s(\"%s\") in %s argument %d\n",`	2641	`error("array over-run in %s(\"%s\") in %s argument %d\n",`
2642	`Fort ? ".Fortran" : ".C",`	2642	`Fort ? ".Fortran" : ".C",`
Line 2660...	Line 2660...
2660	`break;`	2660	`break;`
2661	`case CPLXSXP:`	2661	`case CPLXSXP:`
2662	`if (copy) {`	2662	`if (copy) {`
2663	`s = allocVector(type, n);`	2663	`s = allocVector(type, n);`
2664	`unsigned char ptr = (unsigned char ) p;`	2664	`unsigned char ptr = (unsigned char ) p;`
2665	`memcpy(COMPLEX(s), p, n * sizeof(Rcomplex));`	2665	`if (n) memcpy(COMPLEX(s), p, n * sizeof(Rcomplex));`
2666	`ptr += n * sizeof(Rcomplex);`	2666	`ptr += n * sizeof(Rcomplex);`
2667	`for (int i = 0; i < NG; i++)`	2667	`for (int i = 0; i < NG; i++)`
2668	`if(*ptr++ != FILL)`	2668	`if(*ptr++ != FILL)`
2669	`error("array over-run in %s(\"%s\") in %s argument %d\n",`	2669	`error("array over-run in %s(\"%s\") in %s argument %d\n",`
2670	`Fort ? ".Fortran" : ".C",`	2670	`Fort ? ".Fortran" : ".C",`

The R Project SVN R

(root)/trunk/src/main/dotcode.c @ 63243 – Rev 86452 → 87180