The R Project SVN R

Rev

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

Rev 6191 Rev 6994
Line 57... Line 57...
57 
{
 57 
{
58 
    int *iptr;
 58 
    int *iptr;
59 
    float *sptr;
 59 
    float *sptr;
60 
    double *rptr;
 60 
    double *rptr;
61 
    char **cptr, *fptr;
 61 
    char **cptr, *fptr;
62 
    complex *zptr;
 62 
    Rcomplex *zptr;
63 
    SEXP *lptr, CSingSymbol=install("Csingle");
 63 
    SEXP *lptr, CSingSymbol=install("Csingle");
64 
    int i, l, n;
 64 
    int i, l, n;
65 
 
 65 
 
66 
    switch(TYPEOF(s)) {
 66 
    switch(TYPEOF(s)) {
67 
    case LGLSXP:
 67 
    case LGLSXP:
Line 107... Line 107...
107 
	for (i = 0 ; i < n ; i++) {
 107 
	for (i = 0 ; i < n ; i++) {
108 
	    if(!naok && (!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i)))
 108 
	    if(!naok && (!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i)))
109 
		error("Complex NA/NaN/Inf in foreign function call (arg %d)", narg);
 109 
		error("Complex NA/NaN/Inf in foreign function call (arg %d)", narg);
110 
	}
 110 
	}
111 
	if (dup) {
 111 
	if (dup) {
112 
	    zptr = (complex*)R_alloc(n, sizeof(complex));
 112 
	    zptr = (Rcomplex*)R_alloc(n, sizeof(Rcomplex));
113 
	    for (i = 0 ; i < n ; i++)
 113 
	    for (i = 0 ; i < n ; i++)
114 
		zptr[i] = COMPLEX(s)[i];
 114 
		zptr[i] = COMPLEX(s)[i];
115 
	}
 115 
	}
116 
	return (void*)zptr;
 116 
	return (void*)zptr;
117 
	break;
 117 
	break;
Line 166... Line 166...
166 
{
 166 
{
167 
    int *iptr, n=length(arg);
 167 
    int *iptr, n=length(arg);
168 
    float *sptr;
 168 
    float *sptr;
169 
    double *rptr;
 169 
    double *rptr;
170 
    char **cptr, buf[256];
 170 
    char **cptr, buf[256];
171 
    complex *zptr;
 171 
    Rcomplex *zptr;
172 
    SEXP *lptr, CSingSymbol = install("Csingle");
 172 
    SEXP *lptr, CSingSymbol = install("Csingle");
173 
    int i;
 173 
    int i;
174 
    SEXP s, t;
 174 
    SEXP s, t;
175 
    SEXPTYPE type =TYPEOF(arg);
 175 
    SEXPTYPE type =TYPEOF(arg);
176 
 
 176 
 
Line 193... Line 193...
193 
	    for(i=0 ; i<n ; i++) REAL(s)[i] = rptr[i];
 193 
	    for(i=0 ; i<n ; i++) REAL(s)[i] = rptr[i];
194 
	}
 194 
	}
195 
	break;
 195 
	break;
196 
    case CPLXSXP:
 196 
    case CPLXSXP:
197 
	s = allocVector(type, n);
 197 
	s = allocVector(type, n);
198 
	zptr = (complex*)p;
 198 
	zptr = (Rcomplex*)p;
199 
	for(i=0 ; i<n ; i++) {
 199 
	for(i=0 ; i<n ; i++) {
200 
	    COMPLEX(s)[i] = zptr[i];
 200 
	    COMPLEX(s)[i] = zptr[i];
201 
	}
 201 
	}
202 
	break;
 202 
	break;
203 
    case STRSXP:
 203 
    case STRSXP:
Line 1844... Line 1844...
1844 
	    REAL(CAR(pcall)) = (double*)(arguments[i]);
 1844 
	    REAL(CAR(pcall)) = (double*)(arguments[i]);
1845 
	    LENGTH(CAR(pcall)) = lengths[i];
 1845 
	    LENGTH(CAR(pcall)) = lengths[i];
1846 
	    break;
 1846 
	    break;
1847 
	case CPLXSXP:
 1847 
	case CPLXSXP:
1848 
	    CAR(pcall) = allocSExp(CPLXSXP);
 1848 
	    CAR(pcall) = allocSExp(CPLXSXP);
1849 
	    COMPLEX(CAR(pcall)) = (complex*)(arguments[i]);
 1849 
	    COMPLEX(CAR(pcall)) = (Rcomplex*)(arguments[i]);
1850 
	    LENGTH(CAR(pcall)) = lengths[i];
 1850 
	    LENGTH(CAR(pcall)) = lengths[i];
1851 
	    break;
 1851 
	    break;
1852 
	case STRSXP:
 1852 
	case STRSXP:
1853 
	    n = lengths[i];
 1853 
	    n = lengths[i];
1854 
	    CAR(pcall) = allocVector(STRSXP, n);
 1854 
	    CAR(pcall) = allocVector(STRSXP, n);