The R Project SVN R

Rev

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

Rev 3987 Rev 4562
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  The R Core Team
 4 
 *  Copyright (C) 1997, 1999  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 265... Line 265...
265 
/*   code by Jean Meloche <jean@stat.ubc.ca> */
 265 
/*   code by Jean Meloche <jean@stat.ubc.ca> */
266 
 
 266 
 
267 
SEXP do_External(SEXP call, SEXP op, SEXP args, SEXP env)
 267 
SEXP do_External(SEXP call, SEXP op, SEXP args, SEXP env)
268 
{
 268 
{
269 
      DL_FUNC fun;
 269 
      DL_FUNC fun;
270 
      char buf[128], *p, *q;
 270 
      /*      char buf[128], *p, *q;  */
271 
      SEXP retval;
 271 
      SEXP retval;
272 
 
 272 
 
273 
      /* I don't like this messing with vmax <TSL> */
 273 
      /* I don't like this messing with vmax <TSL> */
274 
      /* vmax = vmaxget(); */
 274 
      /* vmax = vmaxget(); */
275 
      op = CAR(args);
 275 
      op = CAR(args);
276 
      if (!isString(op))
 276 
      if (!isString(op))
277 
	  errorcall(call,"function name must be a string\n");
 277 
	  errorcall(call,"function name must be a string\n");
278 
 
 278 
 
279 
      /* make up load symbol & look it up */
 279 
      /* make up load symbol & look it up */
280 
      p = CHAR(STRING(op)[0]);
 280 
      /*      p = CHAR(STRING(op)[0]);
281 
      q = buf; while ((*q = *p) != '\0') { p++; q++; }
 281 
      q = buf; while ((*q = *p) != '\0') { p++; q++; }
282 
 
 282 
 
283 
      if (!(fun=R_FindSymbol(buf)))
 283 
      if (!(fun=R_FindSymbol(buf))) */
- 
 
 284 
      if (!(fun=R_FindSymbol(CHAR(STRING(op)[0]))))
284 
	  errorcall(call, "C-R function not in load table\n");
 285 
	  errorcall(call, "C-R function not in load table\n");
285 
 
 286 
 
286 
      retval = (SEXP)fun(args);
 287 
      retval = (SEXP)fun(args);
287 
 
 288 
 
288 
      /* vmaxset(vmax); */
 289 
      /* vmaxset(vmax); */