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



    *len = 0;
    for(s = args, prev=args; s != R_NilValue;) {
	if(TAG(s) == NaokSymbol) {
	    *naok = asLogical(CAR(s));
	    /* SETCDR(prev, s = CDR(s)); */
	    if(naokused++ == 1) warning(_("'%s' used more than once"), "NAOK");
	} else if(TAG(s) == DupSymbol) {
	    *dup = asLogical(CAR(s));
	    /* SETCDR(prev, s = CDR(s)); */
	    if(dupused++ == 1) warning(_("'%s' used more than once"), "DUP");
	} else if(TAG(s) == PkgSymbol) {
	    dll->obj = CAR(s);  // really? 
	    if(TYPEOF(CAR(s)) == STRSXP) {
		p = translateChar(STRING_ELT(CAR(s), 0));
		if(strlen(p) > PATH_MAX - 1)
		    error(_("DLL name is too long"));
		dll->type = FILENAME;
		strcpy(dll->DLLname, p);
		if(pkgused++ > 1) 
		    warning(_("'%s' used more than once"), "PACKAGE");
		/* More generally, this should allow us to process
		   any additional arguments and not insist that PACKAGE
		   be the last argument.
		*/
	    } else {

	ss = CDR(s);
	/* Look for PACKAGE=. We look at the next arg, unless
	   this is the last one (which will only happen for one arg),
	   and remove it */
	if(ss == R_NilValue && TAG(s) == PkgSymbol) {
	    if(pkgused++ == 1) 
		warning(_("'%s' used more than once"), "PACKAGE");
	    setDLLname(s, dll->DLLname);
	    dll->type = FILENAME;
	    return R_NilValue;
	}
	if(TAG(ss) == PkgSymbol) {
	    if(pkgused++ == 1) 
		warning(_("'%s' used more than once"), "PACKAGE");
	    setDLLname(ss, dll->DLLname);
	    dll->type = FILENAME;
	    SETCDR(s, CDR(ss));
	}
	s = CDR(s);

    dd->recordGraphics = FALSE;
    PROTECT(retval = do_External(call, op, args, env));
    dd->recordGraphics = record;
    if (GErecording(call, dd)) { // which is record && call != R_NilValue
	if (!GEcheckState(dd))
	    errorcall(call, _("invalid graphics state"));
	GErecordGraphicOperation(op, args, dd);
    }
    UNPROTECT(1);
    return retval;
}

    dd->recordGraphics = FALSE;
    PROTECT(retval = do_dotcall(call, op, args, env));
    dd->recordGraphics = record;
    if (GErecording(call, dd)) {
	if (!GEcheckState(dd))
	    errorcall(call, _("invalid graphics state"));
	GErecordGraphicOperation(op, args, dd);
    }
    UNPROTECT(1);
    return retval;
}

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

		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);

	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);

    SEXP call, pcall, s;
    SEXPTYPE type;
    int i, j, n;
 
    if (!isFunction((SEXP)func))
	error("invalid function in call_R");
    if (nargs < 0)
	error("invalid argument count in call_R");
    if (nres < 0)
	error("invalid return value count in call_R");
    PROTECT(pcall = call = allocList((int) nargs + 1));
    SET_TYPEOF(call, LANGSXP);
    SETCAR(pcall, (SEXP)func);
    s = R_NilValue;		/* -Wall */
    for (i = 0 ; i < nargs ; i++) {

Rev 60765	Rev 60844
Line 345...	Line 345...
345	`*len = 0;`	345	`*len = 0;`
346	`for(s = args, prev=args; s != R_NilValue;) {`	346	`for(s = args, prev=args; s != R_NilValue;) {`
347	`if(TAG(s) == NaokSymbol) {`	347	`if(TAG(s) == NaokSymbol) {`
348	`*naok = asLogical(CAR(s));`	348	`*naok = asLogical(CAR(s));`
349	`/* SETCDR(prev, s = CDR(s)); */`	349	`/* SETCDR(prev, s = CDR(s)); */`
350	`if(naokused++ == 1) warning(_("NAOK used more than once"));`	350	`if(naokused++ == 1) warning(_("'%s' used more than once"), "NAOK");`
351	`} else if(TAG(s) == DupSymbol) {`	351	`} else if(TAG(s) == DupSymbol) {`
352	`*dup = asLogical(CAR(s));`	352	`*dup = asLogical(CAR(s));`
353	`/* SETCDR(prev, s = CDR(s)); */`	353	`/* SETCDR(prev, s = CDR(s)); */`
354	`if(dupused++ == 1) warning(_("DUP used more than once"));`	354	`if(dupused++ == 1) warning(_("'%s' used more than once"), "DUP");`
355	`} else if(TAG(s) == PkgSymbol) {`	355	`} else if(TAG(s) == PkgSymbol) {`
356	`dll->obj = CAR(s); // really?`	356	`dll->obj = CAR(s); // really?`
357	`if(TYPEOF(CAR(s)) == STRSXP) {`	357	`if(TYPEOF(CAR(s)) == STRSXP) {`
358	`p = translateChar(STRING_ELT(CAR(s), 0));`	358	`p = translateChar(STRING_ELT(CAR(s), 0));`
359	`if(strlen(p) > PATH_MAX - 1)`	359	`if(strlen(p) > PATH_MAX - 1)`
360	`error(_("DLL name is too long"));`	360	`error(_("DLL name is too long"));`
361	`dll->type = FILENAME;`	361	`dll->type = FILENAME;`
362	`strcpy(dll->DLLname, p);`	362	`strcpy(dll->DLLname, p);`
-		363	`if(pkgused++ > 1)`
363	`if(pkgused++ > 1) warning(_("PACKAGE used more than once"));`	364	`warning(_("'%s' used more than once"), "PACKAGE");`
364	`/* More generally, this should allow us to process`	365	`/* More generally, this should allow us to process`
365	`any additional arguments and not insist that PACKAGE`	366	`any additional arguments and not insist that PACKAGE`
366	`be the last argument.`	367	`be the last argument.`
367	`*/`	368	`*/`
368	`} else {`	369	`} else {`
Line 422...	Line 423...
422	`ss = CDR(s);`	423	`ss = CDR(s);`
423	`/* Look for PACKAGE=. We look at the next arg, unless`	424	`/* Look for PACKAGE=. We look at the next arg, unless`
424	`this is the last one (which will only happen for one arg),`	425	`this is the last one (which will only happen for one arg),`
425	`and remove it */`	426	`and remove it */`
426	`if(ss == R_NilValue && TAG(s) == PkgSymbol) {`	427	`if(ss == R_NilValue && TAG(s) == PkgSymbol) {`
-		428	`if(pkgused++ == 1)`
427	`if(pkgused++ == 1) warning(_("PACKAGE used more than once"));`	429	`warning(_("'%s' used more than once"), "PACKAGE");`
428	`setDLLname(s, dll->DLLname);`	430	`setDLLname(s, dll->DLLname);`
429	`dll->type = FILENAME;`	431	`dll->type = FILENAME;`
430	`return R_NilValue;`	432	`return R_NilValue;`
431	`}`	433	`}`
432	`if(TAG(ss) == PkgSymbol) {`	434	`if(TAG(ss) == PkgSymbol) {`
-		435	`if(pkgused++ == 1)`
433	`if(pkgused++ == 1) warning(_("PACKAGE used more than once"));`	436	`warning(_("'%s' used more than once"), "PACKAGE");`
434	`setDLLname(ss, dll->DLLname);`	437	`setDLLname(ss, dll->DLLname);`
435	`dll->type = FILENAME;`	438	`dll->type = FILENAME;`
436	`SETCDR(s, CDR(ss));`	439	`SETCDR(s, CDR(ss));`
437	`}`	440	`}`
438	`s = CDR(s);`	441	`s = CDR(s);`
Line 1247...	Line 1250...
1247	`dd->recordGraphics = FALSE;`	1250	`dd->recordGraphics = FALSE;`
1248	`PROTECT(retval = do_External(call, op, args, env));`	1251	`PROTECT(retval = do_External(call, op, args, env));`
1249	`dd->recordGraphics = record;`	1252	`dd->recordGraphics = record;`
1250	`if (GErecording(call, dd)) { // which is record && call != R_NilValue`	1253	`if (GErecording(call, dd)) { // which is record && call != R_NilValue`
1251	`if (!GEcheckState(dd))`	1254	`if (!GEcheckState(dd))`
1252	`errorcall(call, _("Invalid graphics state"));`	1255	`errorcall(call, _("invalid graphics state"));`
1253	`GErecordGraphicOperation(op, args, dd);`	1256	`GErecordGraphicOperation(op, args, dd);`
1254	`}`	1257	`}`
1255	`UNPROTECT(1);`	1258	`UNPROTECT(1);`
1256	`return retval;`	1259	`return retval;`
1257	`}`	1260	`}`
Line 1264...	Line 1267...
1264	`dd->recordGraphics = FALSE;`	1267	`dd->recordGraphics = FALSE;`
1265	`PROTECT(retval = do_dotcall(call, op, args, env));`	1268	`PROTECT(retval = do_dotcall(call, op, args, env));`
1266	`dd->recordGraphics = record;`	1269	`dd->recordGraphics = record;`
1267	`if (GErecording(call, dd)) {`	1270	`if (GErecording(call, dd)) {`
1268	`if (!GEcheckState(dd))`	1271	`if (!GEcheckState(dd))`
1269	`errorcall(call, _("Invalid graphics state"));`	1272	`errorcall(call, _("invalid graphics state"));`
1270	`GErecordGraphicOperation(op, args, dd);`	1273	`GErecordGraphicOperation(op, args, dd);`
1271	`}`	1274	`}`
1272	`UNPROTECT(1);`	1275	`UNPROTECT(1);`
1273	`return retval;`	1276	`return retval;`
1274	`}`	1277	`}`
Line 1448...	Line 1451...
1448	`/* We can loop over all the arguments and report all the`	1451	`/* We can loop over all the arguments and report all the`
1449	`erroneous ones, but then we would also want to avoid`	1452	`erroneous ones, but then we would also want to avoid`
1450	`the conversions. Also, in the future, we may just`	1453	`the conversions. Also, in the future, we may just`
1451	`attempt to coerce the value to the appropriate`	1454	`attempt to coerce the value to the appropriate`
1452	`type. */`	1455	`type. */`
1453	`errorcall(call, _("Wrong type for argument %d in call to %s"),`	1456	`errorcall(call, _("wrong type for argument %d in call to %s"),`
1454	`na+1, symName);`	1457	`na+1, symName);`
1455	`}`	1458	`}`
1456	`int nprotect = 0, targetType = checkTypes ? checkTypes[na] : 0;`	1459	`int nprotect = 0, targetType = checkTypes ? checkTypes[na] : 0;`
1457	`R_xlen_t n;`	1460	`R_xlen_t n;`
1458	`s = CAR(pa);`	1461	`s = CAR(pa);`
Line 1658...	Line 1661...
1658	`if (RTRACE(s)) memtrace_report(s, cargs[na]);`	1661	`if (RTRACE(s)) memtrace_report(s, cargs[na]);`
1659	`#endif`	1662	`#endif`
1660	`}`	1663	`}`
1661	`break;`	1664	`break;`
1662	`case VECSXP:`	1665	`case VECSXP:`
1663	`if (Fort) error(_("invalid mode to pass to Fortran (arg %d)"), na + 1);`	1666	`if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),`
-		1667	`type2char(t), na + 1);`
1664	`/* Used read-only, so this is safe */`	1668	`/* Used read-only, so this is safe */`
1665	`#ifdef USE_RINTERNALS`	1669	`#ifdef USE_RINTERNALS`
1666	`cargs[na] = (void*) DATAPTR(s);`	1670	`cargs[na] = (void*) DATAPTR(s);`
1667	`#else`	1671	`#else`
1668	`n = XLENGTH(s);`	1672	`n = XLENGTH(s);`
Line 1674...	Line 1678...
1674	`case CLOSXP:`	1678	`case CLOSXP:`
1675	`case BUILTINSXP:`	1679	`case BUILTINSXP:`
1676	`case SPECIALSXP:`	1680	`case SPECIALSXP:`
1677	`case ENVSXP:`	1681	`case ENVSXP:`
1678	`if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),`	1682	`if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),`
1679	`type2char(TYPEOF(s)), na + 1);`	1683	`type2char(t), na + 1);`
1680	`cargs[na] = (void*) s;`	1684	`cargs[na] = (void*) s;`
1681	`break;`	1685	`break;`
1682	`case NILSXP:`	1686	`case NILSXP:`
1683	`error(_("invalid mode (%s) to pass to C or Fortran (arg %d)"),`	1687	`error(_("invalid mode (%s) to pass to C or Fortran (arg %d)"),`
1684	`type2char(t), na + 1);`	1688	`type2char(t), na + 1);`
Line 2600...	Line 2604...
2600	`SEXP call, pcall, s;`	2604	`SEXP call, pcall, s;`
2601	`SEXPTYPE type;`	2605	`SEXPTYPE type;`
2602	`int i, j, n;`	2606	`int i, j, n;`
2603		2607
2604	`if (!isFunction((SEXP)func))`	2608	`if (!isFunction((SEXP)func))`
2605	`error(_("invalid function in call_R"));`	2609	`error("invalid function in call_R");`
2606	`if (nargs < 0)`	2610	`if (nargs < 0)`
2607	`error(_("invalid argument count in call_R"));`	2611	`error("invalid argument count in call_R");`
2608	`if (nres < 0)`	2612	`if (nres < 0)`
2609	`error(_("invalid return value count in call_R"));`	2613	`error("invalid return value count in call_R");`
2610	`PROTECT(pcall = call = allocList((int) nargs + 1));`	2614	`PROTECT(pcall = call = allocList((int) nargs + 1));`
2611	`SET_TYPEOF(call, LANGSXP);`	2615	`SET_TYPEOF(call, LANGSXP);`
2612	`SETCAR(pcall, (SEXP)func);`	2616	`SETCAR(pcall, (SEXP)func);`
2613	`s = R_NilValue; /* -Wall */`	2617	`s = R_NilValue; /* -Wall */`
2614	`for (i = 0 ; i < nargs ; i++) {`	2618	`for (i = 0 ; i < nargs ; i++) {`

The R Project SVN R

(root)/trunk/src/main/dotcode.c @ 63243 – Rev 60765 → 60844