The R Project SVN R

Rev

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

Rev 14571 Rev 14577
Line 393... Line 393...
393
}
393
}
394
 
394
 
395
SEXP do_isloaded(SEXP call, SEXP op, SEXP args, SEXP env)
395
SEXP do_isloaded(SEXP call, SEXP op, SEXP args, SEXP env)
396
{
396
{
397
    SEXP ans;
397
    SEXP ans;
398
    char *sym, *pkg;
398
    char *sym, *pkg= "";
399
    int val;
399
    int val = 1, nargs = length(args);
-
 
400
 
-
 
401
    if (nargs < 1) errorcall(call, "no arguments supplied");
400
    checkArity(op, args);
402
    if (nargs > 2) errorcall(call, "too many arguments");
-
 
403
 
401
    if(!isValidString(CAR(args)))
404
    if(!isValidString(CAR(args)))
402
	errorcall(call, R_MSG_IA);
405
	errorcall(call, R_MSG_IA);
403
    sym = CHAR(STRING_ELT(CAR(args), 0));
406
    sym = CHAR(STRING_ELT(CAR(args), 0));
-
 
407
    if(nargs == 2) {
404
    if(!isValidString(CADR(args)))
408
	if(!isValidString(CADR(args)))
405
	errorcall(call, R_MSG_IA);
409
	    errorcall(call, R_MSG_IA);
406
    pkg = CHAR(STRING_ELT(CADR(args), 0));
410
	pkg = CHAR(STRING_ELT(CADR(args), 0));
407
    val = 1;
411
    }
408
    if (!(R_FindSymbol(sym, pkg, NULL)))
412
    if (!(R_FindSymbol(sym, pkg, NULL))) val = 0;
409
	val = 0;
-
 
410
    ans = allocVector(LGLSXP, 1);
413
    ans = allocVector(LGLSXP, 1);
411
    LOGICAL(ans)[0] = val;
414
    LOGICAL(ans)[0] = val;
412
    return ans;
415
    return ans;
413
}
416
}
414
 
417
 
Line 417... Line 420...
417
 
420
 
418
SEXP do_External(SEXP call, SEXP op, SEXP args, SEXP env)
421
SEXP do_External(SEXP call, SEXP op, SEXP args, SEXP env)
419
{
422
{
420
    DL_FUNC fun;
423
    DL_FUNC fun;
421
    SEXP retval;
424
    SEXP retval;
422
    R_RegisteredNativeSymbol symbol = {R_EXTERNAL_SYM, NULL};
425
    R_RegisteredNativeSymbol symbol = {R_EXTERNAL_SYM, {NULL}};
423
    /* I don't like this messing with vmax <TSL> */
426
    /* I don't like this messing with vmax <TSL> */
424
    /* But it is needed for clearing R_alloc and to be like .Call <BDR>*/
427
    /* But it is needed for clearing R_alloc and to be like .Call <BDR>*/
425
    char *vmax = vmaxget();
428
    char *vmax = vmaxget();
426
 
429
 
427
    op = CAR(args);
430
    op = CAR(args);
Line 448... Line 451...
448
/* .Call(name, <args>) */
451
/* .Call(name, <args>) */
449
SEXP do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
452
SEXP do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
450
{
453
{
451
    DL_FUNC fun;
454
    DL_FUNC fun;
452
    SEXP retval, cargs[MAX_ARGS], pargs;
455
    SEXP retval, cargs[MAX_ARGS], pargs;
453
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, NULL};
456
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}};
454
    int nargs;
457
    int nargs;
455
    char *vmax = vmaxget();
458
    char *vmax = vmaxget();
456
    op = CAR(args);
459
    op = CAR(args);
457
    if (!isValidString(op))
460
    if (!isValidString(op))
458
	errorcall(call, "function name must be a string (of length 1)");
461
	errorcall(call, "function name must be a string (of length 1)");
Line 1167... Line 1170...
1167
    void **cargs;
1170
    void **cargs;
1168
    int dup, havenames, naok, nargs, which;
1171
    int dup, havenames, naok, nargs, which;
1169
    DL_FUNC fun;
1172
    DL_FUNC fun;
1170
    SEXP ans, pargs, s;
1173
    SEXP ans, pargs, s;
1171
    R_toCConverter  *argConverters[65];
1174
    R_toCConverter  *argConverters[65];
1172
    R_RegisteredNativeSymbol symbol = {R_C_SYM, NULL};
1175
    R_RegisteredNativeSymbol symbol = {R_C_SYM, {NULL}};
1173
 
1176
 
1174
    char buf[128], *p, *q, *vmax;
1177
    char buf[128], *p, *q, *vmax;
1175
    if (NaokSymbol == NULL || DupSymbol == NULL || PkgSymbol == NULL) {
1178
    if (NaokSymbol == NULL || DupSymbol == NULL || PkgSymbol == NULL) {
1176
	NaokSymbol = install("NAOK");
1179
	NaokSymbol = install("NAOK");
1177
	DupSymbol = install("DUP");
1180
	DupSymbol = install("DUP");