The R Project SVN R

Rev

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

Rev 66552 Rev 66568
Line 155... Line 155...
155 
	/* This is illegal C */
 155 
	/* This is illegal C */
156 
	if(*fun == NULL)
 156 
	if(*fun == NULL)
157 
	    errorcall(call, _("NULL value passed as symbol address"));
 157 
	    errorcall(call, _("NULL value passed as symbol address"));
158 
 
 158 
 
159 
	/* copy the symbol name. */
 159 
	/* copy the symbol name. */
160 
	if (p) {
 160 
	if (p && buf) {
161 
	    if (strlen(p) >= MaxSymbolBytes)
 161 
	    if (strlen(p) >= MaxSymbolBytes)
162 
		error(_("symbol '%s' is too long"), p);
 162 
		error(_("symbol '%s' is too long"), p);
163 
	    memcpy(buf, p, strlen(p)+1);
 163 
	    memcpy(buf, p, strlen(p)+1);
164 
	}
 164 
	}
165 
 
 165 
 
Line 173... Line 173...
173 
    errorcall(call,
 173 
    errorcall(call,
174 
      _("first argument must be a string (of length 1) or native symbol reference"));
 174 
      _("first argument must be a string (of length 1) or native symbol reference"));
175 
    return; /* not reached */
 175 
    return; /* not reached */
176 
}
 176 
}
177 
 
 177 
 
- 
 
 178 
attribute_hidden
- 
 
 179 
DL_FUNC R_dotCallFn(SEXP op, SEXP call, int nargs) {
- 
 
 180 
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}, NULL};
- 
 
 181 
    DL_FUNC fun = NULL;
- 
 
 182 
    checkValidSymbolId(op, call, &fun, &symbol, NULL);
- 
 
 183 
    /* should check arg count here as well */
- 
 
 184 
    return fun;
- 
 
 185 
}
178 
 
 186 
 
179 
/*
 187 
/*
180 
  This is the routine that is called by do_dotCode, do_dotcall and
 188 
  This is the routine that is called by do_dotCode, do_dotcall and
181 
  do_External to find the DL_FUNC to invoke. It handles processing the
 189 
  do_External to find the DL_FUNC to invoke. It handles processing the
182 
  arguments for the PACKAGE argument, if present, and also takes care
 190 
  arguments for the PACKAGE argument, if present, and also takes care
Line 547... Line 555...
547 
typedef SEXP (*VarFun)(...);
 555 
typedef SEXP (*VarFun)(...);
548 
#else
 556 
#else
549 
typedef DL_FUNC VarFun;
 557 
typedef DL_FUNC VarFun;
550 
#endif
 558 
#endif
551 
 
 559 
 
552 
/* .Call(name, <args>) */
 - 
 
553 
SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
 560 
SEXP attribute_hidden R_doDotCall(DL_FUNC ofun, int nargs, SEXP *cargs,
554 
{
 - 
 
555 
    DL_FUNC ofun = NULL;
 561 
				  SEXP call) {
556 
    VarFun fun = NULL;
 562 
    VarFun fun = NULL;
557 
    SEXP retval, cargs[MAX_ARGS], pargs;
 - 
 
558 
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}, NULL};
 - 
 
559 
 
 - 
 
560 
    int nargs;
 - 
 
561 
    const void *vmax = vmaxget();
 - 
 
562 
    char buf[MaxSymbolBytes];
 - 
 
563 
 
 - 
 
564 
    if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
 - 
 
565 
    check1arg2(args, call, ".NAME");
 - 
 
566 
 
 - 
 
567 
    args = resolveNativeRoutine(args, &ofun, &symbol, buf, NULL, NULL, call, env);
 - 
 
568 
    args = CDR(args);
 - 
 
569 
 
 - 
 
570 
    for(nargs = 0, pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
 - 
 
571 
	if (nargs == MAX_ARGS)
 - 
 
572 
	    errorcall(call, _("too many arguments in foreign function call"));
 - 
 
573 
	cargs[nargs] = CAR(pargs);
 - 
 
574 
	nargs++;
 - 
 
575 
    }
 - 
 
576 
    if(symbol.symbol.call && symbol.symbol.call->numArgs > -1) {
 - 
 
577 
	if(symbol.symbol.call->numArgs != nargs)
 - 
 
578 
	    errorcall(call,
 - 
 
579 
		      _("Incorrect number of arguments (%d), expecting %d for '%s'"),
 - 
 
580 
		      nargs, symbol.symbol.call->numArgs, buf);
 - 
 
581 
    }
 - 
 
582 
 
 - 
 
583 
    retval = R_NilValue;	/* -Wall */
 563 
    SEXP retval = R_NilValue;	/* -Wall */
584 
    fun = (VarFun) ofun;
 564 
    fun = (VarFun) ofun;
585 
    switch (nargs) {
 565 
    switch (nargs) {
586 
    case 0:
 566 
    case 0:
587 
	retval = (SEXP)ofun();
 567 
	retval = (SEXP)ofun();
588 
	break;
 568 
	break;
Line 1233... Line 1213...
1233 
	    cargs[60], cargs[61], cargs[62], cargs[63], cargs[64]);
 1213 
	    cargs[60], cargs[61], cargs[62], cargs[63], cargs[64]);
1234 
	break;
 1214 
	break;
1235 
    default:
 1215 
    default:
1236 
	errorcall(call, _("too many arguments, sorry"));
 1216 
	errorcall(call, _("too many arguments, sorry"));
1237 
    }
 1217 
    }
- 
 
 1218 
    return retval;
- 
 
 1219 
}
- 
 
 1220 
 
- 
 
 1221 
/* .Call(name, <args>) */
- 
 
 1222 
SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
- 
 
 1223 
{
- 
 
 1224 
    DL_FUNC ofun = NULL;
- 
 
 1225 
    SEXP retval, cargs[MAX_ARGS], pargs;
- 
 
 1226 
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}, NULL};
- 
 
 1227 
 
- 
 
 1228 
    int nargs;
- 
 
 1229 
    const void *vmax = vmaxget();
- 
 
 1230 
    char buf[MaxSymbolBytes];
- 
 
 1231 
 
- 
 
 1232 
    if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
- 
 
 1233 
    check1arg2(args, call, ".NAME");
- 
 
 1234 
 
- 
 
 1235 
    args = resolveNativeRoutine(args, &ofun, &symbol, buf, NULL, NULL, call, env);
- 
 
 1236 
    args = CDR(args);
- 
 
 1237 
 
- 
 
 1238 
    for(nargs = 0, pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
- 
 
 1239 
	if (nargs == MAX_ARGS)
- 
 
 1240 
	    errorcall(call, _("too many arguments in foreign function call"));
- 
 
 1241 
	cargs[nargs] = CAR(pargs);
- 
 
 1242 
	nargs++;
- 
 
 1243 
    }
- 
 
 1244 
    if(symbol.symbol.call && symbol.symbol.call->numArgs > -1) {
- 
 
 1245 
	if(symbol.symbol.call->numArgs != nargs)
- 
 
 1246 
	    errorcall(call,
- 
 
 1247 
		      _("Incorrect number of arguments (%d), expecting %d for '%s'"),
- 
 
 1248 
		      nargs, symbol.symbol.call->numArgs, buf);
- 
 
 1249 
    }
- 
 
 1250 
 
- 
 
 1251 
    retval = R_doDotCall(ofun, nargs, cargs, call);
1238 
    vmaxset(vmax);
 1252 
    vmaxset(vmax);
1239 
    return retval;
 1253 
    return retval;
1240 
}
 1254 
}
1241 
 
 1255 
 
1242 
/*  Call dynamically loaded "internal" graphics functions
 1256 
/*  Call dynamically loaded "internal" graphics functions