The R Project SVN R

Rev

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

Rev 17794 Rev 18560
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Langage for Statistical Data Analysis
 2 
 *  R : A Computer Langage for Statistical Data Analysis
3 
 *  Copyright (C) 1995  Robert Gentleman and Ross Ihaka
 3 
 *  Copyright (C) 1995  Robert Gentleman and Ross Ihaka
4 
 *  Copyright (C) 1997-2001  The R Development Core Team
 4 
 *  Copyright (C) 1997-2002  The R Development Core Team
5 
 *
 5 
 *
6 
 *  This program is free software; you can redistribute it and/or modify
 6 
 *  This program is free software; you can redistribute it and/or modify
7 
 *  it under the terms of the GNU General Public License as published by
 7 
 *  it under the terms of the GNU General Public License as published by
8 
 *  the Free Software Foundation; either version 2 of the License, or
 8 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 9 
 *  (at your option) any later version.
Line 299... Line 299...
299 
/* find NAOK and DUP, find and remove PACKAGE */
 299 
/* find NAOK and DUP, find and remove PACKAGE */
300 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup)
 300 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup)
301 
{
 301 
{
302 
    SEXP s, prev;
 302 
    SEXP s, prev;
303 
    int nargs=0, naokused=0, dupused=0, pkgused=0;
 303 
    int nargs=0, naokused=0, dupused=0, pkgused=0;
- 
 
 304 
    char *p;
- 
 
 305
304 
    *naok = 0;
 306 
    *naok = 0;
305 
    *dup = 1;
 307 
    *dup = 1;
306 
    *len = 0;
 308 
    *len = 0;
307 
    for(s = args, prev=args; s != R_NilValue;) {
 309 
    for(s = args, prev=args; s != R_NilValue;) {
308 
	if(TAG(s) == NaokSymbol) {
 310 
	if(TAG(s) == NaokSymbol) {
Line 312... Line 314...
312 
	} else if(TAG(s) == DupSymbol) {
 314 
	} else if(TAG(s) == DupSymbol) {
313 
	    *dup = asLogical(CAR(s));
 315 
	    *dup = asLogical(CAR(s));
314 
	    /* SETCDR(prev, s = CDR(s)); */
 316 
	    /* SETCDR(prev, s = CDR(s)); */
315 
	    if(dupused++ == 1) warning("DUP used more than once");
 317 
	    if(dupused++ == 1) warning("DUP used more than once");
316 
	} else if(TAG(s) == PkgSymbol) {
 318 
	} else if(TAG(s) == PkgSymbol) {
317 
	    strcpy(DLLname, CHAR(STRING_ELT(CAR(s), 0)));
 319 
	    p = CHAR(STRING_ELT(CAR(s), 0));
- 
 
 320 
	    if(strlen(p) > PATH_MAX - 1)
- 
 
 321 
		error("DLL name is too long");
- 
 
 322 
	    strcpy(DLLname, p);
318 
	    if(pkgused++ > 1) warning("PACKAGE used more than once");
 323 
	    if(pkgused++ > 1) warning("PACKAGE used more than once");
319 
	    /* More generally, this should allow us to process
 324 
	    /* More generally, this should allow us to process
320 
               any additional arguments and not insist that PACKAGE
 325 
               any additional arguments and not insist that PACKAGE
321 
               be the last argument.
 326 
               be the last argument.
322 
             */
 327 
             */
Line 333... Line 338...
333 
    }
 338 
    }
334 
    *len = nargs;
 339 
    *len = nargs;
335 
    return args;
 340 
    return args;
336 
}
 341 
}
337 
 
 342 
 
338 
static void setDLLname(SEXP s, char *DLLName) {
 343 
static void setDLLname(SEXP s, char *DLLName)
- 
 
 344 
{
339 
  SEXP ss = CAR(s); char *name;
 345 
    SEXP ss = CAR(s); char *name;
340 
  if(TYPEOF(ss) != STRSXP || length(ss) != 1)
 346 
    if(TYPEOF(ss) != STRSXP || length(ss) != 1)
341 
    error("PACKAGE argument must be a single character string");
 347 
	error("PACKAGE argument must be a single character string");
342 
  name = CHAR(STRING_ELT(ss, 0));
 348 
    name = CHAR(STRING_ELT(ss, 0));
343 
  /* allow the package: form of the name, as returned by find */
 349 
    /* allow the package: form of the name, as returned by find */
344 
  if(strncmp(name, "package:", 8) == 0)
 350 
    if(strncmp(name, "package:", 8) == 0)
345 
    name += 8;
 351 
	name += 8;
- 
 
 352 
    if(strlen(name) > PATH_MAX - 1)
- 
 
 353 
	error("PACKAGE argument is too long");
346 
  strcpy(DLLname, name);
 354 
    strcpy(DLLname, name);
347 
}
 355 
}
348 
 
 356 
 
349 
static SEXP pkgtrim(SEXP args)
 357 
static SEXP pkgtrim(SEXP args)
350 
{
 358 
{
351 
    SEXP s, ss;
 359 
    SEXP s, ss;
Line 1232... Line 1240...
1232 
    /* once here, on the way into the call, and */
 1240 
    /* once here, on the way into the call, and */
1233 
    /* once below on the way out. */
 1241 
    /* once below on the way out. */
1234 
    cargs = (void**)R_alloc(nargs, sizeof(void*));
 1242 
    cargs = (void**)R_alloc(nargs, sizeof(void*));
1235 
    nargs = 0;
 1243 
    nargs = 0;
1236 
    for(pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
 1244 
    for(pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
1237 
	cargs[nargs] = RObjToCPtr(CAR(pargs), naok, dup, nargs + 1, which, buf, argConverters + nargs);
 1245 
	cargs[nargs] = RObjToCPtr(CAR(pargs), naok, dup, nargs + 1,
- 
 
 1246 
				  which, buf, argConverters + nargs);
1238 
	nargs++;
 1247 
	nargs++;
1239 
    }
 1248 
    }
1240 
 
 1249 
 
1241 
 
 1250 
 
1242 
    switch (nargs) {
 1251 
    switch (nargs) {