The R Project SVN R

Rev

Rev 61782 | Rev 65019 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 r 1 
/*
26763 maechler 2 
 *  R : A Computer Language for Statistical Data Analysis
2 r 3 
 *  Copyright (C) 1995  Robert Gentleman and Ross Ihaka
59035 ripley 4 
 *  Copyright (C) 1997--2012  The R Core Team
26763 maechler 5 
 *  Copyright (C) 2003	      The R Foundation
2 r 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
11 
 *
12 
 *  This program is distributed in the hope that it will be useful,
13 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 
 *  GNU General Public License for more details.
16 
 *
42307 ripley 17 
 *  You should have received a copy of the GNU General Public License
18 
 *  along with this program; if not, a copy is available at
19 
 *  http://www.r-project.org/Licenses/
2 r 20 
 */
21 
 
5187 hornik 22 
#ifdef HAVE_CONFIG_H
31593 ripley 23 
# include <config.h>
5187 hornik 24 
#endif
25 
 
57538 ripley 26 
#define R_USE_SIGNALS 1
36489 ripley 27 
#include <Defn.h>
60667 ripley 28 
#include <Internal.h>
51841 ripley 29 
#include <ctype.h> /* for tolower */
2 r 30 
#include <string.h>
42398 ripley 31 
#include <errno.h>
2 r 32 
 
11499 ripley 33 
#include <Rmath.h>
5187 hornik 34 
 
14156 duncan 35 
 
5730 ripley 36 
#ifndef max
37 
#define max(a, b) ((a > b)?(a):(b))
38 
#endif
39 
 
60484 ripley 40 
/* Was 'name' prior to 2.13.0, then .NAME, but checked as
60874 ripley 41 
   'name' up to 2.15.1. */
60484 ripley 42 
static void check1arg2(SEXP arg, SEXP call, const char *formal)
43 
{
44 
    if (TAG(arg) == R_NilValue) return;
60588 ripley 45 
    errorcall(call, "the first argument should not be named");
60484 ripley 46 
 }
2 r 47 
 
60484 ripley 48 
 
49 
 
58602 ripley 50 
/* These are set during the first call to do_dotCode() below. */
1839 ihaka 51 
 
2 r 52 
static SEXP NaokSymbol = NULL;
53 
static SEXP DupSymbol = NULL;
6098 pd 54 
static SEXP PkgSymbol = NULL;
32657 ripley 55 
static SEXP EncSymbol = NULL;
58602 ripley 56 
static SEXP CSingSymbol = NULL;
2 r 57 
 
30599 duncan 58 
#include <Rdynpriv.h>
60478 ripley 59 
// Odd: 'type' is really this enum
60585 ripley 60 
enum {NOT_DEFINED, FILENAME, DLL_HANDLE, R_OBJECT};
30599 duncan 61 
typedef struct {
62 
    char DLLname[PATH_MAX];
63 
    HINSTANCE dll;
64 
    SEXP  obj;
65 
    int type;
66 
} DllReference;
6098 pd 67 
 
41901 ripley 68 
/* Maximum length of entry-point name, including nul terminator */
41935 ripley 69 
#define MaxSymbolBytes 1024
41901 ripley 70 
 
60478 ripley 71 
/* Maximum number of args to .C, .Fortran and .Call */
30599 duncan 72 
#define MAX_ARGS 65
73 
 
58767 ripley 74 
/* This looks up entry points in DLLs in a platform specific way. */
31591 ripley 75 
static DL_FUNC
76 
R_FindNativeSymbolFromDLL(char *name, DllReference *dll,
60350 ripley 77 
			  R_RegisteredNativeSymbol *symbol, SEXP env);
30599 duncan 78 
 
31591 ripley 79 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup,
80 
		     DllReference *dll);
30599 duncan 81 
static SEXP pkgtrim(SEXP args, DllReference *dll);
82 
 
83 
/*
60478 ripley 84 
  Called from resolveNativeRoutine (and itself).
85 
 
30599 duncan 86 
  Checks whether the specified object correctly identifies a native routine.
60478 ripley 87 
  op is the supplied value for .NAME.  This can be
88 
   a) a string (when this does nothing).
31591 ripley 89 
   b) an external pointer giving the address of the routine
90 
      (e.g. getNativeSymbolInfo("foo")$address)
30599 duncan 91 
   c) or a NativeSymbolInfo itself  (e.g. getNativeSymbolInfo("foo"))
32364 ripley 92 
 
60478 ripley 93 
   It copies the symbol name to buf.
94 
 
95 
   NB: in the last two cases it sets fun and symbol as well!
30599 duncan 96 
 */
32364 ripley 97 
static void
41901 ripley 98 
checkValidSymbolId(SEXP op, SEXP call, DL_FUNC *fun,
99 
		   R_RegisteredNativeSymbol *symbol, char *buf)
30599 duncan 100 
{
32364 ripley 101 
    if (isValidString(op)) return;
30599 duncan 102 
 
36902 duncan 103 
    if(TYPEOF(op) == EXTPTRSXP) {
41901 ripley 104 
	char *p = NULL;
48346 maechler 105 
	if(R_ExternalPtrTag(op) == install("native symbol"))
45446 ripley 106 
	   *fun = R_ExternalPtrAddrFn(op);
48346 maechler 107 
	else if(R_ExternalPtrTag(op) == install("registered native symbol")) {
45446 ripley 108 
	   R_RegisteredNativeSymbol *tmp;
36902 duncan 109 
	   tmp = (R_RegisteredNativeSymbol *) R_ExternalPtrAddr(op);
110 
	   if(tmp) {
45446 ripley 111 
	      if(symbol->type != R_ANY_SYM && symbol->type != tmp->type)
112 
		 errorcall(call, _("NULL value passed as symbol address"));
113 
		/* Check the type of the symbol. */
114 
	      switch(symbol->type) {
36902 duncan 115 
	      case R_C_SYM:
45446 ripley 116 
		  *fun = tmp->symbol.c->fun;
117 
		  p = tmp->symbol.c->name;
36902 duncan 118 
		  break;
119 
	      case R_CALL_SYM:
45446 ripley 120 
		  *fun = tmp->symbol.call->fun;
121 
		  p = tmp->symbol.call->name;
36902 duncan 122 
		  break;
123 
	      case R_FORTRAN_SYM:
45446 ripley 124 
		  *fun = tmp->symbol.fortran->fun;
125 
		  p = tmp->symbol.fortran->name;
36902 duncan 126 
		  break;
127 
	      case R_EXTERNAL_SYM:
45446 ripley 128 
		  *fun = tmp->symbol.external->fun;
129 
		  p = tmp->symbol.external->name;
36902 duncan 130 
		  break;
131 
	      default:
45446 ripley 132 
		 /* Something unintended has happened if we get here. */
133 
		  errorcall(call, _("Unimplemented type %d in createRSymbolObject"),
41713 ripley 134 
			    symbol->type);
45446 ripley 135 
		  break;
36902 duncan 136 
	      }
137 
	      *symbol = *tmp;
138 
	   }
139 
	}
32364 ripley 140 
	/* This is illegal C */
36902 duncan 141 
	if(*fun == NULL)
32867 ripley 142 
	    errorcall(call, _("NULL value passed as symbol address"));
36902 duncan 143 
 
45446 ripley 144 
	/* copy the symbol name. */
36902 duncan 145 
	if (p) {
41901 ripley 146 
	    if (strlen(p) >= MaxSymbolBytes)
147 
		error(_("symbol '%s' is too long"), p);
148 
	    memcpy(buf, p, strlen(p)+1);
36902 duncan 149 
	}
150 
 
32369 ripley 151 
	return;
45446 ripley 152 
    }
33297 ripley 153 
    else if(inherits(op, "NativeSymbolInfo")) {
36902 duncan 154 
	checkValidSymbolId(VECTOR_ELT(op, 1), call, fun, symbol, buf);
32364 ripley 155 
	return;
156 
    }
45446 ripley 157 
 
32867 ripley 158 
    errorcall(call,
60746 ripley 159 
      _("first argument must be a string (of length 1) or native symbol reference"));
32364 ripley 160 
    return; /* not reached */
30599 duncan 161 
}
162 
 
163 
 
164 
/*
31591 ripley 165 
  This is the routine that is called by do_dotCode, do_dotcall and
166 
  do_External to find the DL_FUNC to invoke. It handles processing the
167 
  arguments for the PACKAGE argument, if present, and also takes care
168 
  of the cases where we are given a NativeSymbolInfo object, an
169 
  address directly, and if the DLL is specified. If no PACKAGE is
170 
  provided, we check whether the calling function is in a namespace
30599 duncan 171 
  and look there.
172 
*/
41901 ripley 173 
 
38705 ripley 174 
static SEXP
31591 ripley 175 
resolveNativeRoutine(SEXP args, DL_FUNC *fun,
176 
		     R_RegisteredNativeSymbol *symbol, char *buf,
60348 ripley 177 
		     int *nargs, int *naok, int *dup, SEXP call, SEXP env)
30599 duncan 178 
{
179 
    SEXP op;
41784 ripley 180 
    const char *p; char *q;
60585 ripley 181 
    DllReference dll;
182 
    /* This is used as shorthand for 'all' in R_FindSymbol, but
183 
       should never be supplied */
184 
    strcpy(dll.DLLname, "");
185 
    dll.dll = NULL; dll.obj = NULL; dll.type = NOT_DEFINED;
186 
 
60348 ripley 187 
    op = CAR(args);  // value of .NAME =
36902 duncan 188 
    /* NB, this sets fun, symbol and buf and is not just a check! */
45446 ripley 189 
    checkValidSymbolId(op, call, fun, symbol, buf);
30599 duncan 190 
 
191 
    /* The following code modifies the argument list */
192 
    /* We know this is ok because do_dotCode is entered */
193 
    /* with its arguments evaluated. */
194 
 
195 
    if(symbol->type == R_C_SYM || symbol->type == R_FORTRAN_SYM) {
60348 ripley 196 
	/* And that also looks for PACKAGE = */
30599 duncan 197 
	args = naokfind(CDR(args), nargs, naok, dup, &dll);
198 
	if(*naok == NA_LOGICAL)
35265 ripley 199 
	    errorcall(call, _("invalid '%s' value"), "naok");
30599 duncan 200 
	if(*nargs > MAX_ARGS)
32867 ripley 201 
	    errorcall(call, _("too many arguments in foreign function call"));
30599 duncan 202 
    } else {
34761 ripley 203 
	/* This has the side effect of setting dll.type if a PACKAGE=
60478 ripley 204 
	   argument if found, but it will only be used if a string was
205 
	   passed in  */
30599 duncan 206 
	args = pkgtrim(args, &dll);
207 
    }
60488 ripley 208 
 
209 
    /* We were given a symbol (or an address), so we are done. */
210 
    if (*fun) return args;
211 
 
212 
    if (dll.type == FILENAME && !strlen(dll.DLLname))
60348 ripley 213 
	errorcall(call, _("PACKAGE = \"\" is invalid"));
60364 ripley 214 
 
60587 ripley 215 
    // find if we were called from a namespace
216 
    SEXP env2 = ENCLOS(env);
217 
    const char *ns = "";
218 
    if(R_IsNamespaceEnv(env2))
219 
	ns = CHAR(STRING_ELT(R_NamespaceEnvSpec(env2), 0));
220 
    else env2 = R_NilValue;
221 
 
60348 ripley 222 
#ifdef CHECK_CROSS_USAGE
60488 ripley 223 
    if (dll.type == FILENAME && strcmp(dll.DLLname, "base")) {
60348 ripley 224 
	if(strlen(ns) && strcmp(dll.DLLname, ns) &&
225 
	   !(streql(dll.DLLname, "BioC_graph") && streql(ns, "graph")))
226 
	    warningcall(call,
227 
			"using PACKAGE = \"%s\" from namespace '%s'",
228 
			dll.DLLname, ns);
229 
    }
230 
#endif
30599 duncan 231 
 
60488 ripley 232 
    /* Make up the load symbol */
30599 duncan 233 
    if(TYPEOF(op) == STRSXP) {
63181 ripley 234 
	const void *vmax = vmaxget();
40705 ripley 235 
	p = translateChar(STRING_ELT(op, 0));
41901 ripley 236 
	if(strlen(p) >= MaxSymbolBytes)
237 
	    error(_("symbol '%s' is too long"), p);
30599 duncan 238 
	q = buf;
239 
	while ((*q = *p) != '\0') {
59173 ripley 240 
	    if(symbol->type == R_FORTRAN_SYM) *q = (char) tolower(*q);
30599 duncan 241 
	    p++;
242 
	    q++;
243 
	}
63181 ripley 244 
	vmaxset(vmax);
31591 ripley 245 
    }
45446 ripley 246 
 
60488 ripley 247 
    if(dll.type != FILENAME && strlen(ns)) {
248 
	/* no PACKAGE= arg, so see if we can identify a DLL
249 
	   from the namespace defining the function */
250 
	*fun = R_FindNativeSymbolFromDLL(buf, &dll, symbol, env2);
251 
	if (*fun) return args;
60765 ripley 252 
	errorcall(call, "\"%s\" not resolved from current namespace (%s)",
253 
		  buf, ns);
60488 ripley 254 
    }
30604 duncan 255 
 
60488 ripley 256 
    /* NB: the actual conversion to the symbol is done in
257 
       R_dlsym in Rdynload.c.  That prepends an underscore (usually),
258 
       and may append one or more underscores.
259 
    */
37711 ripley 260 
 
60488 ripley 261 
    *fun = R_FindSymbol(buf, dll.DLLname, symbol);
262 
    if (*fun) return args;
263 
 
264 
    /* so we've failed and bail out */
265 
    if(strlen(dll.DLLname)) {
266 
	switch(symbol->type) {
267 
	case R_C_SYM:
268 
	    errorcall(call,
269 
		      _("\"%s\" not available for %s() for package \"%s\""),
270 
		      buf, ".C", dll.DLLname);
271 
	    break;
272 
	case R_FORTRAN_SYM:
273 
	    errorcall(call,
274 
		      _("\"%s\" not available for %s() for package \"%s\""),
275 
		      buf, ".Fortran", dll.DLLname);
276 
	    break;
277 
	case R_CALL_SYM:
278 
	    errorcall(call,
279 
		      _("\"%s\" not available for %s() for package \"%s\""),
280 
		      buf, ".Call", dll.DLLname);
281 
	    break;
282 
	case R_EXTERNAL_SYM:
283 
	    errorcall(call,
284 
		      _("\"%s\" not available for %s() for package \"%s\""),
285 
		      buf, ".External", dll.DLLname);
286 
	    break;
287 
	case R_ANY_SYM:
288 
	    errorcall(call,
289 
		      _("%s symbol name \"%s\" not in DLL for package \"%s\""),
290 
		      "C/Fortran", buf, dll.DLLname);
291 
	    break;
30599 duncan 292 
	}
60488 ripley 293 
    } else
294 
	errorcall(call, _("%s symbol name \"%s\" not in load table"),
295 
		  symbol->type == R_FORTRAN_SYM ? "Fortran" : "C", buf);
30599 duncan 296 
 
60488 ripley 297 
    return args; /* -Wall */
30599 duncan 298 
}
299 
 
300 
 
22284 duncan 301 
static Rboolean
302 
checkNativeType(int targetType, int actualType)
303 
{
31593 ripley 304 
    if(targetType > 0) {
305 
	if(targetType == INTSXP || targetType == LGLSXP) {
306 
	    return(actualType == INTSXP || actualType == LGLSXP);
307 
	}
308 
	return(targetType == actualType);
309 
    }
22284 duncan 310 
 
31593 ripley 311 
    return(TRUE);
22284 duncan 312 
}
313 
 
6098 pd 314 
 
20110 duncan 315 
static Rboolean
316 
comparePrimitiveTypes(R_NativePrimitiveArgType type, SEXP s, Rboolean dup)
317 
{
22284 duncan 318 
   if(type == ANYSXP || TYPEOF(s) == type)
20110 duncan 319 
      return(TRUE);
2 r 320 
 
20110 duncan 321 
   if(dup && type == SINGLESXP)
322 
      return(asLogical(getAttrib(s, install("Csingle"))) == TRUE);
323 
 
324 
   return(FALSE);
325 
}
326 
 
327 
 
1839 ihaka 328 
/* Foreign Function Interface.  This code allows a user to call C */
329 
/* or Fortran code which is either statically or dynamically linked. */
2 r 330 
 
31593 ripley 331 
/* NB: this leaves NAOK and DUP arguments on the list */
2 r 332 
 
6098 pd 333 
/* find NAOK and DUP, find and remove PACKAGE */
31591 ripley 334 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup,
335 
		     DllReference *dll)
6098 pd 336 
{
14571 duncan 337 
    SEXP s, prev;
6098 pd 338 
    int nargs=0, naokused=0, dupused=0, pkgused=0;
41784 ripley 339 
    const char *p;
26763 maechler 340 
 
6098 pd 341 
    *naok = 0;
342 
    *dup = 1;
343 
    *len = 0;
14571 duncan 344 
    for(s = args, prev=args; s != R_NilValue;) {
6098 pd 345 
	if(TAG(s) == NaokSymbol) {
346 
	    *naok = asLogical(CAR(s));
14571 duncan 347 
	    /* SETCDR(prev, s = CDR(s)); */
60844 ripley 348 
	    if(naokused++ == 1) warning(_("'%s' used more than once"), "NAOK");
6098 pd 349 
	} else if(TAG(s) == DupSymbol) {
350 
	    *dup = asLogical(CAR(s));
14571 duncan 351 
	    /* SETCDR(prev, s = CDR(s)); */
60844 ripley 352 
	    if(dupused++ == 1) warning(_("'%s' used more than once"), "DUP");
14571 duncan 353 
	} else if(TAG(s) == PkgSymbol) {
60368 ripley 354 
	    dll->obj = CAR(s);  // really?
30599 duncan 355 
	    if(TYPEOF(CAR(s)) == STRSXP) {
40705 ripley 356 
		p = translateChar(STRING_ELT(CAR(s), 0));
30599 duncan 357 
		if(strlen(p) > PATH_MAX - 1)
32867 ripley 358 
		    error(_("DLL name is too long"));
30599 duncan 359 
		dll->type = FILENAME;
360 
		strcpy(dll->DLLname, p);
60844 ripley 361 
		if(pkgused++ > 1)
362 
		    warning(_("'%s' used more than once"), "PACKAGE");
30599 duncan 363 
		/* More generally, this should allow us to process
364 
		   any additional arguments and not insist that PACKAGE
365 
		   be the last argument.
366 
		*/
367 
	    } else {
60348 ripley 368 
		/* Have a DLL object, which is not something documented .... */
45446 ripley 369 
		if(TYPEOF(CAR(s)) == EXTPTRSXP) {
30599 duncan 370 
		    dll->dll = (HINSTANCE) R_ExternalPtrAddr(CAR(s));
371 
		    dll->type = DLL_HANDLE;
372 
		} else if(TYPEOF(CAR(s)) == VECSXP) {
373 
		    dll->type = R_OBJECT;
374 
		    dll->obj = s;
31591 ripley 375 
		    strcpy(dll->DLLname,
40705 ripley 376 
			   translateChar(STRING_ELT(VECTOR_ELT(CAR(s), 1), 0)));
30599 duncan 377 
		    dll->dll = (HINSTANCE) R_ExternalPtrAddr(VECTOR_ELT(s, 4));
60368 ripley 378 
		} else
379 
		    error("incorrect type (%s) of PACKAGE argument\n",
380 
			  type2char(TYPEOF(CAR(s))));
30599 duncan 381 
	    }
17794 duncan 382 
	} else {
383 
	    nargs++;
384 
	    prev = s;
385 
	    s = CDR(s);
386 
	    continue;
387 
	}
26763 maechler 388 
	if(s == args)
17794 duncan 389 
	    args = s = CDR(s);
26763 maechler 390 
	else
17794 duncan 391 
	    SETCDR(prev, s = CDR(s));
6098 pd 392 
    }
393 
    *len = nargs;
394 
    return args;
395 
}
396 
 
30599 duncan 397 
static void setDLLname(SEXP s, char *DLLname)
18560 ripley 398 
{
41807 rgentlem 399 
    SEXP ss = CAR(s);
41784 ripley 400 
    const char *name;
401 
 
18560 ripley 402 
    if(TYPEOF(ss) != STRSXP || length(ss) != 1)
32867 ripley 403 
	error(_("PACKAGE argument must be a single character string"));
40705 ripley 404 
    name = translateChar(STRING_ELT(ss, 0));
18560 ripley 405 
    /* allow the package: form of the name, as returned by find */
406 
    if(strncmp(name, "package:", 8) == 0)
407 
	name += 8;
408 
    if(strlen(name) > PATH_MAX - 1)
32867 ripley 409 
	error(_("PACKAGE argument is too long"));
18560 ripley 410 
    strcpy(DLLname, name);
14018 jmc 411 
}
412 
 
30599 duncan 413 
static SEXP pkgtrim(SEXP args, DllReference *dll)
6098 pd 414 
{
415 
    SEXP s, ss;
60350 ripley 416 
    int pkgused = 0;
6098 pd 417 
 
60350 ripley 418 
    if (PkgSymbol == NULL) PkgSymbol = install("PACKAGE");
419 
 
6098 pd 420 
    for(s = args ; s != R_NilValue;) {
421 
	ss = CDR(s);
422 
	/* Look for PACKAGE=. We look at the next arg, unless
423 
	   this is the last one (which will only happen for one arg),
424 
	   and remove it */
425 
	if(ss == R_NilValue && TAG(s) == PkgSymbol) {
60844 ripley 426 
	    if(pkgused++ == 1)
427 
		warning(_("'%s' used more than once"), "PACKAGE");
30599 duncan 428 
	    setDLLname(s, dll->DLLname);
429 
	    dll->type = FILENAME;
6098 pd 430 
	    return R_NilValue;
431 
	}
432 
	if(TAG(ss) == PkgSymbol) {
60844 ripley 433 
	    if(pkgused++ == 1)
434 
		warning(_("'%s' used more than once"), "PACKAGE");
30599 duncan 435 
	    setDLLname(ss, dll->DLLname);
436 
	    dll->type = FILENAME;
10172 luke 437 
	    SETCDR(s, CDR(ss));
6098 pd 438 
	}
439 
	s = CDR(s);
440 
    }
441 
    return args;
442 
}
443 
 
58663 ripley 444 
static SEXP enctrim(SEXP args)
32657 ripley 445 
{
58666 ripley 446 
    SEXP s, ss;
2 r 447 
 
32657 ripley 448 
    for(s = args ; s != R_NilValue;) {
449 
	ss = CDR(s);
450 
	/* Look for ENCODING=. We look at the next arg, unless
451 
	   this is the last one (which will only happen for one arg),
452 
	   and remove it */
453 
	if(ss == R_NilValue && TAG(s) == EncSymbol) {
58663 ripley 454 
	    warning("ENCODING is defunct and will be ignored");
32657 ripley 455 
	    return R_NilValue;
456 
	}
457 
	if(TAG(ss) == EncSymbol) {
58663 ripley 458 
	    warning("ENCODING is defunct and will be ignored");
32657 ripley 459 
	    SETCDR(s, CDR(ss));
460 
	}
461 
	s = CDR(s);
462 
    }
463 
    return args;
464 
}
30599 duncan 465 
 
32657 ripley 466 
 
37711 ripley 467 
 
36990 ripley 468 
SEXP attribute_hidden do_isloaded(SEXP call, SEXP op, SEXP args, SEXP env)
2 r 469 
{
41807 rgentlem 470 
    const char *sym, *type="", *pkg = "";
14577 ripley 471 
    int val = 1, nargs = length(args);
45209 ripley 472 
    R_RegisteredNativeSymbol symbol = {R_ANY_SYM, {NULL}, NULL};
14577 ripley 473 
 
41713 ripley 474 
    if (nargs < 1) error(_("no arguments supplied"));
475 
    if (nargs > 3) error(_("too many arguments"));
14577 ripley 476 
 
6098 pd 477 
    if(!isValidString(CAR(args)))
49076 ripley 478 
	error(_("invalid '%s' argument"), "symbol");
40705 ripley 479 
    sym = translateChar(STRING_ELT(CAR(args), 0));
36047 ripley 480 
    if(nargs >= 2) {
14577 ripley 481 
	if(!isValidString(CADR(args)))
49076 ripley 482 
	    error(_("invalid '%s' argument"), "PACKAGE");
40705 ripley 483 
	pkg = translateChar(STRING_ELT(CADR(args), 0));
14577 ripley 484 
    }
36047 ripley 485 
    if(nargs >= 3) {
486 
	if(!isValidString(CADDR(args)))
49076 ripley 487 
	    error(_("invalid '%s' argument"), "type");
40705 ripley 488 
	type = CHAR(STRING_ELT(CADDR(args), 0)); /* ASCII */
36047 ripley 489 
	if(strcmp(type, "C") == 0) symbol.type = R_C_SYM;
490 
	else if(strcmp(type, "Fortran") == 0) symbol.type = R_FORTRAN_SYM;
491 
	else if(strcmp(type, "Call") == 0) symbol.type = R_CALL_SYM;
492 
	else if(strcmp(type, "External") == 0) symbol.type = R_EXTERNAL_SYM;
493 
    }
45209 ripley 494 
    if(!(R_FindSymbol(sym, pkg, &symbol))) val = 0;
41894 ripley 495 
    return ScalarLogical(val);
2 r 496 
}
497 
 
59276 ripley 498 
/*   Call dynamically loaded "internal" functions.
499 
     Original code by Jean Meloche <jean@stat.ubc.ca> */
3822 thomas 500 
 
39866 duncan 501 
typedef SEXP (*R_ExternalRoutine)(SEXP);
59393 ripley 502 
typedef SEXP (*R_ExternalRoutine2)(SEXP, SEXP, SEXP, SEXP);
39866 duncan 503 
 
36990 ripley 504 
SEXP attribute_hidden do_External(SEXP call, SEXP op, SEXP args, SEXP env)
3822 thomas 505 
{
40034 ripley 506 
    DL_FUNC ofun = NULL;
6098 pd 507 
    SEXP retval;
17164 duncan 508 
    R_RegisteredNativeSymbol symbol = {R_EXTERNAL_SYM, {NULL}, NULL};
50745 ripley 509 
    const void *vmax = vmaxget();
41901 ripley 510 
    char buf[MaxSymbolBytes];
3822 thomas 511 
 
58666 ripley 512 
    if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
60484 ripley 513 
    check1arg2(args, call, ".NAME");
40034 ripley 514 
    args = resolveNativeRoutine(args, &ofun, &symbol, buf, NULL, NULL,
60348 ripley 515 
				NULL, call, env);
3822 thomas 516 
 
61692 ripley 517 
    if(symbol.symbol.external && symbol.symbol.external->numArgs > -1) {
518 
	int nargs = length(args) - 1;
61782 ripley 519 
	if(symbol.symbol.external->numArgs != nargs)
520 
	    errorcall(call,
521 
		      _("Incorrect number of arguments (%d), expecting %d for '%s'"),
522 
		      nargs, symbol.symbol.external->numArgs, buf);
61692 ripley 523 
    }
524 
 
59276 ripley 525 
    if (PRIMVAL(op) == 1) {
526 
	R_ExternalRoutine2 fun = (R_ExternalRoutine2) ofun;
59393 ripley 527 
	retval = fun(call, op, args, env);
59276 ripley 528 
    } else {
529 
	R_ExternalRoutine fun = (R_ExternalRoutine) ofun;
530 
	retval = fun(args);
14571 duncan 531 
    }
6098 pd 532 
    vmaxset(vmax);
533 
    return retval;
3822 thomas 534 
}
535 
 
39866 duncan 536 
#ifdef __cplusplus
537 
typedef SEXP (*VarFun)(...);
538 
#else
539 
typedef DL_FUNC VarFun;
540 
#endif
10983 ihaka 541 
 
6098 pd 542 
/* .Call(name, <args>) */
36990 ripley 543 
SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
4855 ihaka 544 
{
39866 duncan 545 
    DL_FUNC ofun = NULL;
546 
    VarFun fun = NULL;
55061 ripley 547 
    SEXP retval, cargs[MAX_ARGS], pargs;
17164 duncan 548 
    R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}, NULL};
60587 ripley 549 
 
4855 ihaka 550 
    int nargs;
50745 ripley 551 
    const void *vmax = vmaxget();
41901 ripley 552 
    char buf[MaxSymbolBytes];
6098 pd 553 
 
58666 ripley 554 
    if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
60484 ripley 555 
    check1arg2(args, call, ".NAME");
60587 ripley 556 
 
39866 duncan 557 
    args = resolveNativeRoutine(args, &ofun, &symbol, buf, NULL, NULL,
60348 ripley 558 
				NULL, call, env);
4855 ihaka 559 
    args = CDR(args);
5231 hornik 560 
 
4855 ihaka 561 
    for(nargs = 0, pargs = args ; pargs != R_NilValue; pargs = CDR(pargs)) {
45446 ripley 562 
	if (nargs == MAX_ARGS)
563 
	    errorcall(call, _("too many arguments in foreign function call"));
4855 ihaka 564 
	cargs[nargs] = CAR(pargs);
565 
	nargs++;
566 
    }
14571 duncan 567 
    if(symbol.symbol.call && symbol.symbol.call->numArgs > -1) {
568 
	if(symbol.symbol.call->numArgs != nargs)
41713 ripley 569 
	    errorcall(call,
53823 ripley 570 
		      _("Incorrect number of arguments (%d), expecting %d for '%s'"),
47366 ripley 571 
		      nargs, symbol.symbol.call->numArgs, buf);
14571 duncan 572 
    }
5231 hornik 573 
 
574 
    retval = R_NilValue;	/* -Wall */
39866 duncan 575 
    fun = (VarFun) ofun;
4855 ihaka 576 
    switch (nargs) {
577 
    case 0:
39866 duncan 578 
	retval = (SEXP)ofun();
4855 ihaka 579 
	break;
580 
    case 1:
581 
	retval = (SEXP)fun(cargs[0]);
582 
	break;
583 
    case 2:
584 
	retval = (SEXP)fun(cargs[0], cargs[1]);
585 
	break;
586 
    case 3:
587 
	retval = (SEXP)fun(cargs[0], cargs[1], cargs[2]);
588 
	break;
589 
    case 4:
590 
	retval = (SEXP)fun(cargs[0], cargs[1], cargs[2], cargs[3]);
591 
	break;
592 
    case 5:
593 
	retval = (SEXP)fun(
594 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4]);
595 
	break;
596 
    case 6:
597 
	retval = (SEXP)fun(
598 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
599 
	    cargs[5]);
600 
	break;
601 
    case 7:
602 
	retval = (SEXP)fun(
603 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
604 
	    cargs[5],  cargs[6]);
605 
	break;
606 
    case 8:
607 
	retval = (SEXP)fun(
608 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
609 
	    cargs[5],  cargs[6],  cargs[7]);
610 
	break;
611 
    case 9:
612 
	retval = (SEXP)fun(
613 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
614 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8]);
615 
	break;
616 
    case 10:
617 
	retval = (SEXP)fun(
618 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
619 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9]);
620 
	break;
621 
    case 11:
622 
	retval = (SEXP)fun(
623 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
624 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
625 
	    cargs[10]);
626 
	break;
627 
    case 12:
628 
	retval = (SEXP)fun(
629 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
630 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
631 
	    cargs[10], cargs[11]);
632 
	break;
633 
    case 13:
634 
	retval = (SEXP)fun(
635 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
636 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
637 
	    cargs[10], cargs[11], cargs[12]);
638 
	break;
639 
    case 14:
640 
	retval = (SEXP)fun(
641 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
642 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
643 
	    cargs[10], cargs[11], cargs[12], cargs[13]);
644 
	break;
645 
    case 15:
646 
	retval = (SEXP)fun(
647 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
648 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
649 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14]);
650 
	break;
651 
    case 16:
652 
	retval = (SEXP)fun(
653 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
654 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
655 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
656 
	    cargs[15]);
657 
	break;
658 
    case 17:
659 
	retval = (SEXP)fun(
660 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
661 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
662 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
663 
	    cargs[15], cargs[16]);
664 
	break;
665 
    case 18:
666 
	retval = (SEXP)fun(
667 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
668 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
669 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
670 
	    cargs[15], cargs[16], cargs[17]);
671 
	break;
672 
    case 19:
673 
	retval = (SEXP)fun(
674 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
675 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
676 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
677 
	    cargs[15], cargs[16], cargs[17], cargs[18]);
678 
	break;
679 
    case 20:
680 
	retval = (SEXP)fun(
681 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
682 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
683 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
684 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19]);
685 
	break;
686 
    case 21:
687 
	retval = (SEXP)fun(
688 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
689 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
690 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
691 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
692 
	    cargs[20]);
693 
	break;
694 
    case 22:
695 
	retval = (SEXP)fun(
696 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
697 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
698 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
699 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
700 
	    cargs[20], cargs[21]);
701 
	break;
702 
    case 23:
703 
	retval = (SEXP)fun(
704 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
705 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
706 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
707 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
708 
	    cargs[20], cargs[21], cargs[22]);
709 
	break;
710 
    case 24:
711 
	retval = (SEXP)fun(
712 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
713 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
714 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
715 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
716 
	    cargs[20], cargs[21], cargs[22], cargs[23]);
717 
	break;
718 
    case 25:
719 
	retval = (SEXP)fun(
720 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
721 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
722 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
723 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
724 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24]);
725 
	break;
726 
    case 26:
727 
	retval = (SEXP)fun(
728 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
729 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
730 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
731 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
732 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
733 
	    cargs[25]);
734 
	break;
735 
    case 27:
736 
	retval = (SEXP)fun(
737 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
738 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
739 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
740 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
741 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
742 
	    cargs[25], cargs[26]);
743 
	break;
744 
    case 28:
745 
	retval = (SEXP)fun(
746 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
747 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
748 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
749 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
750 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
751 
	    cargs[25], cargs[26], cargs[27]);
752 
	break;
753 
    case 29:
754 
	retval = (SEXP)fun(
755 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
756 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
757 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
758 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
759 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
760 
	    cargs[25], cargs[26], cargs[27], cargs[28]);
761 
	break;
762 
    case 30:
763 
	retval = (SEXP)fun(
764 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
765 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
766 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
767 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
768 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
769 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29]);
770 
	break;
771 
    case 31:
772 
	retval = (SEXP)fun(
773 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
774 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
775 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
776 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
777 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
778 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
779 
	    cargs[30]);
780 
	break;
781 
    case 32:
782 
	retval = (SEXP)fun(
783 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
784 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
785 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
786 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
787 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
788 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
789 
	    cargs[30], cargs[31]);
790 
	break;
791 
    case 33:
792 
	retval = (SEXP)fun(
793 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
794 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
795 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
796 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
797 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
798 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
799 
	    cargs[30], cargs[31], cargs[32]);
800 
	break;
801 
    case 34:
802 
	retval = (SEXP)fun(
803 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
804 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
805 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
806 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
807 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
808 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
809 
	    cargs[30], cargs[31], cargs[32], cargs[33]);
810 
	break;
811 
    case 35:
812 
	retval = (SEXP)fun(
813 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
814 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
815 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
816 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
817 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
818 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
819 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34]);
820 
	break;
821 
    case 36:
822 
	retval = (SEXP)fun(
823 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
824 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
825 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
826 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
827 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
828 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
829 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
830 
	    cargs[35]);
831 
	break;
832 
    case 37:
833 
	retval = (SEXP)fun(
834 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
835 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
836 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
837 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
838 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
839 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
840 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
841 
	    cargs[35], cargs[36]);
842 
	break;
843 
    case 38:
844 
	retval = (SEXP)fun(
845 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
846 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
847 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
848 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
849 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
850 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
851 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
852 
	    cargs[35], cargs[36], cargs[37]);
853 
	break;
854 
    case 39:
855 
	retval = (SEXP)fun(
856 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
857 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
858 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
859 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
860 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
861 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
862 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
863 
	    cargs[35], cargs[36], cargs[37], cargs[38]);
864 
	break;
865 
    case 40:
866 
	retval = (SEXP)fun(
867 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
868 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
869 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
870 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
871 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
872 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
873 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
874 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39]);
875 
	break;
876 
    case 41:
877 
	retval = (SEXP)fun(
878 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
879 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
880 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
881 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
882 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
883 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
884 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
885 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
886 
	    cargs[40]);
887 
	break;
888 
    case 42:
889 
	retval = (SEXP)fun(
890 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
891 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
892 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
893 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
894 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
895 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
896 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
897 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
898 
	    cargs[40], cargs[41]);
899 
	break;
900 
    case 43:
901 
	retval = (SEXP)fun(
902 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
903 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
904 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
905 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
906 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
907 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
908 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
909 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
910 
	    cargs[40], cargs[41], cargs[42]);
911 
	break;
912 
    case 44:
913 
	retval = (SEXP)fun(
914 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
915 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
916 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
917 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
918 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
919 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
920 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
921 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
922 
	    cargs[40], cargs[41], cargs[42], cargs[43]);
923 
	break;
924 
    case 45:
925 
	retval = (SEXP)fun(
926 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
927 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
928 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
929 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
930 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
931 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
932 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
933 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
934 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44]);
935 
	break;
936 
    case 46:
937 
	retval = (SEXP)fun(
938 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
939 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
940 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
941 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
942 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
943 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
944 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
945 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
946 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
947 
	    cargs[45]);
948 
	break;
949 
    case 47:
950 
	retval = (SEXP)fun(
951 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
952 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
953 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
954 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
955 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
956 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
957 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
958 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
959 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
960 
	    cargs[45], cargs[46]);
961 
	break;
962 
    case 48:
963 
	retval = (SEXP)fun(
964 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
965 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
966 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
967 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
968 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
969 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
970 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
971 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
972 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
973 
	    cargs[45], cargs[46], cargs[47]);
974 
	break;
975 
    case 49:
976 
	retval = (SEXP)fun(
977 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
978 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
979 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
980 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
981 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
982 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
983 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
984 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
985 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
986 
	    cargs[45], cargs[46], cargs[47], cargs[48]);
987 
	break;
988 
    case 50:
989 
	retval = (SEXP)fun(
990 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
991 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
992 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
993 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
994 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
995 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
996 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
997 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
998 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
999 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49]);
1000 
	break;
1001 
    case 51:
1002 
	retval = (SEXP)fun(
1003 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1004 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1005 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1006 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1007 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1008 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1009 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1010 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1011 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1012 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1013 
	    cargs[50]);
1014 
	break;
1015 
    case 52:
1016 
	retval = (SEXP)fun(
1017 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1018 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1019 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1020 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1021 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1022 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1023 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1024 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1025 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1026 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1027 
	    cargs[50], cargs[51]);
1028 
	break;
1029 
    case 53:
1030 
	retval = (SEXP)fun(
1031 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1032 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1033 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1034 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1035 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1036 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1037 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1038 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1039 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1040 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1041 
	    cargs[50], cargs[51], cargs[52]);
1042 
	break;
1043 
    case 54:
1044 
	retval = (SEXP)fun(
1045 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1046 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1047 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1048 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1049 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1050 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1051 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1052 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1053 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1054 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1055 
	    cargs[50], cargs[51], cargs[52], cargs[53]);
1056 
	break;
1057 
    case 55:
1058 
	retval = (SEXP)fun(
1059 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1060 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1061 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1062 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1063 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1064 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1065 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1066 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1067 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1068 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1069 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54]);
1070 
	break;
1071 
    case 56:
1072 
	retval = (SEXP)fun(
1073 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1074 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1075 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1076 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1077 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1078 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1079 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1080 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1081 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1082 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1083 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1084 
	    cargs[55]);
1085 
	break;
1086 
    case 57:
1087 
	retval = (SEXP)fun(
1088 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1089 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1090 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1091 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1092 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1093 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1094 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1095 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1096 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1097 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1098 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1099 
	    cargs[55], cargs[56]);
1100 
	break;
1101 
    case 58:
1102 
	retval = (SEXP)fun(
1103 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1104 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1105 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1106 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1107 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1108 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1109 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1110 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1111 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1112 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1113 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1114 
	    cargs[55], cargs[56], cargs[57]);
1115 
	break;
1116 
    case 59:
1117 
	retval = (SEXP)fun(
1118 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1119 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1120 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1121 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1122 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1123 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1124 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1125 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1126 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1127 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1128 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1129 
	    cargs[55], cargs[56], cargs[57], cargs[58]);
1130 
	break;
1131 
    case 60:
1132 
	retval = (SEXP)fun(
1133 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1134 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1135 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1136 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1137 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1138 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1139 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1140 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1141 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1142 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1143 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1144 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59]);
1145 
	break;
1146 
    case 61:
1147 
	retval = (SEXP)fun(
1148 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1149 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1150 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1151 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1152 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1153 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1154 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1155 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1156 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1157 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1158 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1159 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
1160 
	    cargs[60]);
1161 
	break;
1162 
    case 62:
1163 
	retval = (SEXP)fun(
1164 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1165 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1166 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1167 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1168 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1169 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1170 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1171 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1172 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1173 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1174 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1175 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
1176 
	    cargs[60], cargs[61]);
1177 
	break;
1178 
    case 63:
1179 
	retval = (SEXP)fun(
1180 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1181 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1182 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1183 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1184 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1185 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1186 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1187 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1188 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1189 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1190 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1191 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
1192 
	    cargs[60], cargs[61], cargs[62]);
1193 
	break;
1194 
    case 64:
1195 
	retval = (SEXP)fun(
1196 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1197 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1198 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1199 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1200 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1201 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1202 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1203 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1204 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1205 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1206 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1207 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
1208 
	    cargs[60], cargs[61], cargs[62], cargs[63]);
1209 
	break;
1210 
    case 65:
1211 
	retval = (SEXP)fun(
1212 
	    cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1213 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1214 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1215 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1216 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1217 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1218 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1219 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1220 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
1221 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
1222 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
1223 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
1224 
	    cargs[60], cargs[61], cargs[62], cargs[63], cargs[64]);
1225 
	break;
1226 
    default:
32867 ripley 1227 
	errorcall(call, _("too many arguments, sorry"));
4855 ihaka 1228 
    }
4869 ihaka 1229 
    vmaxset(vmax);
4855 ihaka 1230 
    return retval;
1231 
}
1232 
 
44311 ripley 1233 
/*  Call dynamically loaded "internal" graphics functions
59267 ripley 1234 
    .External.graphics (used in graphics) and  .Call.graphics (used in grid).
51272 ripley 1235 
 
1236 
    If there is an error or user-interrupt in the above
1237 
    evaluation, dd->recordGraphics is set to TRUE
1238 
    on all graphics devices (see GEonExit(); called in errors.c)
1239 
 
1240 
    NOTE: if someone uses try() around this call and there
1241 
    is an error, then dd->recordGraphics stays FALSE, so
1242 
    subsequent pages of graphics output are NOT saved on
1243 
    the display list.  A workaround is to deliberately
1244 
    force an error in a graphics call (e.g., a grid popViewport()
1245 
    while in the ROOT viewport) which will reset dd->recordGraphics
1246 
    to TRUE as per the comment above.
44311 ripley 1247 
*/
10983 ihaka 1248 
 
59276 ripley 1249 
#include <R_ext/GraphicsEngine.h>
1250 
 
36990 ripley 1251 
SEXP attribute_hidden do_Externalgr(SEXP call, SEXP op, SEXP args, SEXP env)
10983 ihaka 1252 
{
30832 murrell 1253 
    SEXP retval;
44285 ripley 1254 
    pGEDevDesc dd = GEcurrentDevice();
31938 murrell 1255 
    Rboolean record = dd->recordGraphics;
1256 
    dd->recordGraphics = FALSE;
30832 murrell 1257 
    PROTECT(retval = do_External(call, op, args, env));
31938 murrell 1258 
    dd->recordGraphics = record;
59276 ripley 1259 
    if (GErecording(call, dd)) { // which is record && call != R_NilValue
30832 murrell 1260 
	if (!GEcheckState(dd))
60844 ripley 1261 
	    errorcall(call, _("invalid graphics state"));
30832 murrell 1262 
	GErecordGraphicOperation(op, args, dd);
10983 ihaka 1263 
    }
30832 murrell 1264 
    UNPROTECT(1);
10983 ihaka 1265 
    return retval;
1266 
}
1267 
 
36990 ripley 1268 
SEXP attribute_hidden do_dotcallgr(SEXP call, SEXP op, SEXP args, SEXP env)
10983 ihaka 1269 
{
30832 murrell 1270 
    SEXP retval;
44285 ripley 1271 
    pGEDevDesc dd = GEcurrentDevice();
31938 murrell 1272 
    Rboolean record = dd->recordGraphics;
1273 
    dd->recordGraphics = FALSE;
30832 murrell 1274 
    PROTECT(retval = do_dotcall(call, op, args, env));
31938 murrell 1275 
    dd->recordGraphics = record;
1276 
    if (GErecording(call, dd)) {
30832 murrell 1277 
	if (!GEcheckState(dd))
60844 ripley 1278 
	    errorcall(call, _("invalid graphics state"));
30832 murrell 1279 
	GErecordGraphicOperation(op, args, dd);
10983 ihaka 1280 
    }
30832 murrell 1281 
    UNPROTECT(1);
10983 ihaka 1282 
    return retval;
1283 
}
1284 
 
30599 duncan 1285 
static SEXP
44201 ripley 1286 
Rf_getCallingDLL(void)
30599 duncan 1287 
{
1288 
    SEXP e, ans;
34761 ripley 1289 
    RCNTXT *cptr;
1290 
    SEXP rho = R_NilValue;
1291 
    Rboolean found = FALSE;
1292 
 
34768 ripley 1293 
    /* First find the environment of the caller.
1294 
       Testing shows this is the right caller, despite the .C/.Call ...
1295 
     */
1296 
    for (cptr = R_GlobalContext;
34761 ripley 1297 
	 cptr != NULL && cptr->callflag != CTXT_TOPLEVEL;
1298 
	 cptr = cptr->nextcontext)
1299 
	    if (cptr->callflag & CTXT_FUNCTION) {
34768 ripley 1300 
		/* PrintValue(cptr->call); */
34761 ripley 1301 
		rho = cptr->cloenv;
1302 
		break;
1303 
	    }
1304 
    /* Then search up until we hit a namespace or globalenv.
1305 
       The idea is that we will not find a namespace unless the caller
1306 
       was defined in one. */
1307 
    while(rho != R_NilValue) {
1308 
	if (rho == R_GlobalEnv) break;
1309 
	else if (R_IsNamespaceEnv(rho)) {
1310 
	    found = TRUE;
1311 
	    break;
1312 
	}
1313 
	rho = ENCLOS(rho);
1314 
    }
1315 
    if(!found) return R_NilValue;
1316 
 
48346 maechler 1317 
    PROTECT(e = lang2(install("getCallingDLLe"), rho));
30599 duncan 1318 
    ans = eval(e,  R_GlobalEnv);
1319 
    UNPROTECT(1);
1320 
    return(ans);
1321 
}
1322 
 
1323 
 
1324 
/*
1325 
  We are given the PACKAGE argument in dll.obj
1326 
  and we can try to figure out how to resolve this.
31591 ripley 1327 
  0) dll.obj is NULL.  Then find the environment of the
60348 ripley 1328 
   calling function and if it is a namespace, get the first registered DLL.
31591 ripley 1329 
 
30599 duncan 1330 
  1) dll.obj is a DLLInfo object
1331 
*/
1332 
static DL_FUNC
31591 ripley 1333 
R_FindNativeSymbolFromDLL(char *name, DllReference *dll,
60350 ripley 1334 
			  R_RegisteredNativeSymbol *symbol,
1335 
			  SEXP env)
30599 duncan 1336 
{
1337 
    int numProtects = 0;
1338 
    DllInfo *info;
1339 
    DL_FUNC fun = NULL;
1340 
 
1341 
    if(dll->obj == NULL) {
34768 ripley 1342 
	/* Rprintf("\nsearching for %s\n", name); */
60350 ripley 1343 
	if (env != R_NilValue) {
1344 
	    SEXP e;
1345 
	    PROTECT(e = lang2(install("getCallingDLLe"), env));
1346 
	    dll->obj = eval(e, R_GlobalEnv);
1347 
	    UNPROTECT(1);
1348 
	} else dll->obj = Rf_getCallingDLL();
30599 duncan 1349 
	PROTECT(dll->obj); numProtects++;
1350 
    }
1351 
 
1352 
    if(inherits(dll->obj, "DLLInfo")) {
1353 
	SEXP tmp;
1354 
	tmp = VECTOR_ELT(dll->obj, 4);
1355 
	info = (DllInfo *) R_ExternalPtrAddr(tmp);
31591 ripley 1356 
	if(!info)
32867 ripley 1357 
	    error(_("NULL value for DLLInfoReference when looking for DLL"));
30599 duncan 1358 
	fun = R_dlsym(info, name, symbol);
1359 
    }
1360 
 
60364 ripley 1361 
    if(numProtects) UNPROTECT(numProtects);
30599 duncan 1362 
 
60348 ripley 1363 
    return fun;
30599 duncan 1364 
}
1365 
 
1366 
 
1367 
 
6098 pd 1368 
/* .C() {op=0}  or  .Fortran() {op=1} */
58682 ripley 1369 
/* Use of this except for atomic vectors is not allowed for .Fortran,
1370 
   and is only kept for legacy code for .C.
1371 
 
1372 
   CRAN packages R2Cuba, RCALI, ars, coxme, fCopulae, locfit, nlme,
1373 
   splinesurv and survival pass functions, the case of RCALI as a list
1374 
   of two functions.
1375 
 
1376 
   RecordLinkage and locfit pass lists.
1377 
*/
58916 ripley 1378 
 
58930 ripley 1379 
/* pattern and number of guard bytes */
58918 ripley 1380 
#define FILL 0xee
58930 ripley 1381 
#define NG 64
58916 ripley 1382 
 
36990 ripley 1383 
SEXP attribute_hidden do_dotCode(SEXP call, SEXP op, SEXP args, SEXP env)
2 r 1384 
{
59132 ripley 1385 
    void **cargs, **cargs0 = NULL /* -Wall */;
58854 ripley 1386 
    int dup, naok, na, nargs, Fort;
58918 ripley 1387 
    Rboolean havenames, copy = R_CBoundsCheck; /* options(CboundsCheck) */
39866 duncan 1388 
    DL_FUNC ofun = NULL;
1389 
    VarFun fun = NULL;
58854 ripley 1390 
    SEXP ans, pa, s;
17164 duncan 1391 
    R_RegisteredNativeSymbol symbol = {R_C_SYM, {NULL}, NULL};
20110 duncan 1392 
    R_NativePrimitiveArgType *checkTypes = NULL;
1393 
    R_NativeArgStyle *argStyles = NULL;
63181 ripley 1394 
    const void *vmax;
58663 ripley 1395 
    char symName[MaxSymbolBytes];
14571 duncan 1396 
 
58666 ripley 1397 
    if (length(args) < 1) errorcall(call, _("'.NAME' is missing"));
60484 ripley 1398 
    check1arg2(args, call, ".NAME");
6098 pd 1399 
    if (NaokSymbol == NULL || DupSymbol == NULL || PkgSymbol == NULL) {
1839 ihaka 1400 
	NaokSymbol = install("NAOK");
1401 
	DupSymbol = install("DUP");
6098 pd 1402 
	PkgSymbol = install("PACKAGE");
1839 ihaka 1403 
    }
32657 ripley 1404 
    if (EncSymbol == NULL) EncSymbol = install("ENCODING");
58602 ripley 1405 
    if (CSingSymbol == NULL) CSingSymbol = install("Csingle");
1839 ihaka 1406 
    vmax = vmaxget();
58670 ripley 1407 
    Fort = PRIMVAL(op);
1408 
    if(Fort) symbol.type = R_FORTRAN_SYM;
1016 maechler 1409 
 
58663 ripley 1410 
    args = enctrim(args);
39866 duncan 1411 
    args = resolveNativeRoutine(args, &ofun, &symbol, symName, &nargs,
60348 ripley 1412 
				&naok, &dup, call, env);
39866 duncan 1413 
    fun = (VarFun) ofun;
2 r 1414 
 
14571 duncan 1415 
    if(symbol.symbol.c && symbol.symbol.c->numArgs > -1) {
1416 
	if(symbol.symbol.c->numArgs != nargs)
41713 ripley 1417 
	    errorcall(call,
53823 ripley 1418 
		      _("Incorrect number of arguments (%d), expecting %d for '%s'"),
41713 ripley 1419 
		      nargs, symbol.symbol.c->numArgs, symName);
26763 maechler 1420 
 
30599 duncan 1421 
	checkTypes = symbol.symbol.c->types;
1422 
	argStyles = symbol.symbol.c->styles;
14571 duncan 1423 
    }
14156 duncan 1424 
 
58854 ripley 1425 
    /* Construct the return value */
1426 
    nargs = 0;
1427 
    havenames = FALSE;
1428 
    for(pa = args ; pa != R_NilValue; pa = CDR(pa)) {
1429 
	if (TAG(pa) != R_NilValue) havenames = TRUE;
1430 
	nargs++;
1431 
    }
30599 duncan 1432 
 
58854 ripley 1433 
    PROTECT(ans = allocVector(VECSXP, nargs));
1434 
    if (havenames) {
1435 
	SEXP names;
1436 
	PROTECT(names = allocVector(STRSXP, nargs));
1437 
	for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
1438 
	    if (TAG(pa) == R_NilValue)
1439 
		SET_STRING_ELT(names, na, R_BlankString);
1440 
	    else
1441 
		SET_STRING_ELT(names, na, PRINTNAME(TAG(pa)));
1442 
	}
1443 
	setAttrib(ans, R_NamesSymbol, names);
1444 
	UNPROTECT(1);
1445 
    }
1446 
 
58916 ripley 1447 
    /* Convert the arguments for use in foreign function calls. */
58602 ripley 1448 
    cargs = (void**) R_alloc(nargs, sizeof(void*));
59135 ripley 1449 
    if (copy) cargs0 = (void**) R_alloc(nargs, sizeof(void*));
58854 ripley 1450 
    for(na = 0, pa = args ; pa != R_NilValue; pa = CDR(pa), na++) {
45446 ripley 1451 
	if(checkTypes &&
58854 ripley 1452 
	   !comparePrimitiveTypes(checkTypes[na], CAR(pa), dup)) {
45446 ripley 1453 
	    /* We can loop over all the arguments and report all the
1454 
	       erroneous ones, but then we would also want to avoid
1455 
	       the conversions.  Also, in the future, we may just
1456 
	       attempt to coerce the value to the appropriate
58861 ripley 1457 
	       type. */
60844 ripley 1458 
	    errorcall(call, _("wrong type for argument %d in call to %s"),
58854 ripley 1459 
		      na+1, symName);
20110 duncan 1460 
	}
59011 ripley 1461 
	int nprotect = 0, targetType =  checkTypes ? checkTypes[na] : 0;
1462 
	R_xlen_t n;
58855 ripley 1463 
	s = CAR(pa);
58861 ripley 1464 
	/* start with return value a copy of the inputs, as that is
1465 
	   what is needed for DUP = FALSE and for non-atomic-vector inputs */
1466 
	SET_VECTOR_ELT(ans, na, s);
58855 ripley 1467 
 
1468 
	if(checkNativeType(targetType, TYPEOF(s)) == FALSE) {
1469 
	    if(!dup) {
1470 
		error(_("explicit request not to duplicate arguments in call to '%s', but argument %d is of the wrong type (%d != %d)"),
1471 
		      symName, na + 1, targetType, TYPEOF(s));
1472 
	    }
1473 
 
1474 
	    if(targetType != SINGLESXP) {
1475 
		/* Cannot be called if DUP = FALSE, so only needs to live
1476 
		   until copied in the switch.
1477 
		   But R_alloc allocates, so missed protection < R 2.15.0.
1478 
		*/
1479 
		PROTECT(s = coerceVector(s, targetType));
1480 
		nprotect++;
1481 
	    }
1482 
	}
1483 
 
58892 ripley 1484 
	/* We create any copies needed for the return value here,
1485 
	   except for character vectors.  The compiled code works on
1486 
	   the data pointer of the return value for the other atomic
1487 
	   vectors, and anything else is supposed to be read-only.
58870 ripley 1488 
 
58892 ripley 1489 
	   We do not need to copy if the inputs have NAMED = 0 */
1490 
 
60132 ripley 1491 
#ifdef LONG_VECTOR_SUPPORT
1492 
	if (isVector(s) && IS_LONG_VEC(s))
1493 
	    error(_("long vectors (argument %d) are not supported in %s"),
1494 
		  na + 1, Fort ? ".C" : ".Fortran");
1495 
#endif
58870 ripley 1496 
	SEXPTYPE t = TYPEOF(s);
1497 
	switch(t) {
58855 ripley 1498 
	case RAWSXP:
58918 ripley 1499 
	    if (copy && dup) {
59011 ripley 1500 
		n = XLENGTH(s);
1501 
		char *ptr = R_alloc(n * sizeof(Rbyte) + 2 * NG, 1);
58930 ripley 1502 
		memset(ptr, FILL, n * sizeof(Rbyte) + 2 * NG);
1503 
		ptr += NG;
1504 
		memcpy(ptr, RAW(s), n);
1505 
		cargs[na] = (void *) ptr;
58918 ripley 1506 
	    } else if (dup && NAMED(s)) {
59011 ripley 1507 
		n = XLENGTH(s);
58892 ripley 1508 
		SEXP ss = allocVector(t, n);
58911 ripley 1509 
		memcpy(RAW(ss), RAW(s), n * sizeof(Rbyte));
58892 ripley 1510 
		SET_VECTOR_ELT(ans, na, ss);
1511 
		cargs[na] = (void*) RAW(ss);
58954 ripley 1512 
#ifdef R_MEMORY_PROFILING
59520 ripley 1513 
		if (RTRACE(s)) memtrace_report(s, ss);
58954 ripley 1514 
#endif
58892 ripley 1515 
	    } else cargs[na] = (void *) RAW(s);
58855 ripley 1516 
	    break;
1517 
	case LGLSXP:
1518 
	case INTSXP:
59011 ripley 1519 
	    n = XLENGTH(s);
58855 ripley 1520 
	    int *iptr = INTEGER(s);
1521 
	    if (!naok)
59011 ripley 1522 
		for (R_xlen_t i = 0 ; i < n ; i++)
58855 ripley 1523 
		    if(iptr[i] == NA_INTEGER)
1524 
			error(_("NAs in foreign function call (arg %d)"), na + 1);
58918 ripley 1525 
	    if (copy && dup) {
58930 ripley 1526 
		char *ptr = R_alloc(n * sizeof(int) + 2 * NG, 1);
1527 
		memset(ptr, FILL, n * sizeof(int) + 2 * NG);
1528 
		ptr += NG;
1529 
		memcpy(ptr, INTEGER(s), n * sizeof(int));
1530 
		cargs[na] = (void*) ptr;
58918 ripley 1531 
	    } else if (dup && NAMED(s)) {
58892 ripley 1532 
		SEXP ss = allocVector(t, n);
1533 
		memcpy(INTEGER(ss), INTEGER(s), n * sizeof(int));
1534 
		SET_VECTOR_ELT(ans, na, ss);
1535 
		cargs[na] = (void*) INTEGER(ss);
58954 ripley 1536 
#ifdef R_MEMORY_PROFILING
59520 ripley 1537 
		if (RTRACE(s)) memtrace_report(s, ss);
58954 ripley 1538 
#endif
58892 ripley 1539 
	    } else cargs[na] = (void*) iptr;
58855 ripley 1540 
	    break;
1541 
	case REALSXP:
59011 ripley 1542 
	    n = XLENGTH(s);
58855 ripley 1543 
	    double *rptr = REAL(s);
1544 
	    if (!naok)
59011 ripley 1545 
		for (R_xlen_t i = 0 ; i < n ; i++)
58855 ripley 1546 
		    if(!R_FINITE(rptr[i]))
1547 
			error(_("NA/NaN/Inf in foreign function call (arg %d)"), na + 1);
1548 
	    if (asLogical(getAttrib(s, CSingSymbol)) == 1) {
1549 
		float *sptr = (float*) R_alloc(n, sizeof(float));
59011 ripley 1550 
		for (R_xlen_t i = 0 ; i < n ; i++) sptr[i] = (float) REAL(s)[i];
58855 ripley 1551 
		cargs[na] = (void*) sptr;
59701 murdoch 1552 
		if (!dup) warning(_("single values not returned if not duplicated"));
58954 ripley 1553 
#ifdef R_MEMORY_PROFILING
1554 
		if (RTRACE(s)) memtrace_report(s, sptr);
1555 
#endif
58918 ripley 1556 
	    } else if (copy && dup) {
58930 ripley 1557 
		char *ptr = R_alloc(n * sizeof(double) + 2 * NG, 1);
1558 
		memset(ptr, FILL, n * sizeof(double) + 2 * NG);
1559 
		ptr += NG;
1560 
		memcpy(ptr, REAL(s), n * sizeof(double));
1561 
		cargs[na] = (void*) ptr;
58870 ripley 1562 
	    } else if (dup && NAMED(s)) {
58892 ripley 1563 
		SEXP ss  = allocVector(t, n);
1564 
		memcpy(REAL(ss), REAL(s), n * sizeof(double));
1565 
		SET_VECTOR_ELT(ans, na, ss);
1566 
		cargs[na] = (void*) REAL(ss);
58954 ripley 1567 
#ifdef R_MEMORY_PROFILING
59520 ripley 1568 
		if (RTRACE(s)) memtrace_report(s, ss);
58954 ripley 1569 
#endif
58855 ripley 1570 
	    } else cargs[na] = (void*) rptr;
1571 
	    break;
1572 
	case CPLXSXP:
59011 ripley 1573 
	    n = XLENGTH(s);
58855 ripley 1574 
	    Rcomplex *zptr = COMPLEX(s);
1575 
	    if (!naok)
59011 ripley 1576 
		for (R_xlen_t i = 0 ; i < n ; i++)
58855 ripley 1577 
		    if(!R_FINITE(zptr[i].r) || !R_FINITE(zptr[i].i))
1578 
			error(_("complex NA/NaN/Inf in foreign function call (arg %d)"), na + 1);
58918 ripley 1579 
	    if (copy && dup) {
58930 ripley 1580 
		char *ptr = R_alloc(n * sizeof(Rcomplex) + 2 * NG, 1);
1581 
		memset(ptr, FILL, n * sizeof(Rcomplex) + 2 * NG);
1582 
		ptr += NG;
1583 
		memcpy(ptr, COMPLEX(s), n * sizeof(Rcomplex));
1584 
		cargs[na] = (void*) ptr;
58918 ripley 1585 
	    } else if (dup && NAMED(s)) {
58892 ripley 1586 
		SEXP ss = allocVector(t, n);
58911 ripley 1587 
		memcpy(COMPLEX(ss), COMPLEX(s), n * sizeof(Rcomplex));
58892 ripley 1588 
		SET_VECTOR_ELT(ans, na, ss);
1589 
		cargs[na] = (void*) COMPLEX(ss);
58954 ripley 1590 
#ifdef R_MEMORY_PROFILING
59520 ripley 1591 
		if (RTRACE(s)) memtrace_report(s, ss);
58954 ripley 1592 
#endif
58892 ripley 1593 
	    } else cargs[na] = (void *) zptr;
58855 ripley 1594 
	    break;
1595 
	case STRSXP:
1596 
	    if (!dup)
1597 
		error(_("character variables must be duplicated in .C/.Fortran"));
59011 ripley 1598 
	    n = XLENGTH(s);
58855 ripley 1599 
	    if (Fort) {
1600 
		const char *ss = translateChar(STRING_ELT(s, 0));
1601 
		if (n > 1)
1602 
		    warning(_("only first string in char vector used in .Fortran"));
1603 
		char *fptr = (char*) R_alloc(max(255, strlen(ss)) + 1, sizeof(char));
1604 
		strcpy(fptr, ss);
1605 
		cargs[na] =  (void*) fptr;
59132 ripley 1606 
	    } else if (copy) {
59135 ripley 1607 
		char **cptr = (char**) R_alloc(n, sizeof(char*)),
1608 
		    **cptr0 = (char**) R_alloc(n, sizeof(char*));
59132 ripley 1609 
		for (R_xlen_t i = 0 ; i < n ; i++) {
1610 
		    const char *ss = translateChar(STRING_ELT(s, i));
59173 ripley 1611 
		    size_t nn = strlen(ss) + 1 + 2 * NG;
59140 ripley 1612 
		    char *ptr = (char*) R_alloc(nn, sizeof(char));
1613 
		    memset(ptr, FILL, nn);
59135 ripley 1614 
		    cptr[i] = cptr0[i] = ptr + NG;
59132 ripley 1615 
		    strcpy(cptr[i], ss);
1616 
		}
1617 
		cargs[na] = (void*) cptr;
59135 ripley 1618 
		cargs0[na] = (void*) cptr0;
59132 ripley 1619 
#ifdef R_MEMORY_PROFILING
1620 
		if (RTRACE(s)) memtrace_report(s, cargs[na]);
1621 
#endif
58855 ripley 1622 
	    } else {
1623 
		char **cptr = (char**) R_alloc(n, sizeof(char*));
59011 ripley 1624 
		for (R_xlen_t i = 0 ; i < n ; i++) {
58855 ripley 1625 
		    const char *ss = translateChar(STRING_ELT(s, i));
59173 ripley 1626 
		    size_t nn = strlen(ss) + 1;
59140 ripley 1627 
		    if(nn > 1) {
1628 
			cptr[i] = (char*) R_alloc(nn, sizeof(char));
1629 
			strcpy(cptr[i], ss);
1630 
		    } else {
1631 
			/* Protect ourselves against those who like to
1632 
			   extend "", maybe using strncpy */
1633 
			nn = 128;
1634 
			cptr[i] = (char*) R_alloc(nn, sizeof(char));
1635 
			memset(cptr[i], 0, nn);
1636 
		    }
58855 ripley 1637 
		}
1638 
		cargs[na] = (void*) cptr;
58954 ripley 1639 
#ifdef R_MEMORY_PROFILING
1640 
		if (RTRACE(s)) memtrace_report(s, cargs[na]);
1641 
#endif
58855 ripley 1642 
	    }
1643 
	    break;
1644 
	case VECSXP:
60844 ripley 1645 
	    if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
1646 
			    type2char(t), na + 1);
59140 ripley 1647 
	    /* Used read-only, so this is safe */
58876 ripley 1648 
#ifdef USE_RINTERNALS
58870 ripley 1649 
	    cargs[na] = (void*) DATAPTR(s);
58876 ripley 1650 
#else
59011 ripley 1651 
	    n = XLENGTH(s);
58876 ripley 1652 
	    SEXP *lptr = (SEXP *) R_alloc(n, sizeof(SEXP));
59011 ripley 1653 
	    for (R_xlen_t i = 0 ; i < n ; i++) lptr[i] = VECTOR_ELT(s, i);
58876 ripley 1654 
	    cargs[na] = (void*) lptr;
1655 
#endif
58855 ripley 1656 
	    break;
1657 
	case CLOSXP:
1658 
	case BUILTINSXP:
1659 
	case SPECIALSXP:
1660 
	case ENVSXP:
1661 
	    if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
60844 ripley 1662 
			    type2char(t), na + 1);
58855 ripley 1663 
	    cargs[na] =  (void*) s;
1664 
	    break;
1665 
	case NILSXP:
1666 
	    error(_("invalid mode (%s) to pass to C or Fortran (arg %d)"),
58870 ripley 1667 
		  type2char(t), na + 1);
58976 ripley 1668 
	    cargs[na] =  (void*) s;
58855 ripley 1669 
	    break;
1670 
	default:
1671 
	    /* Includes pairlists from R 2.15.0 */
1672 
	    if (Fort) error(_("invalid mode (%s) to pass to Fortran (arg %d)"),
1673 
			    type2char(t), na + 1);
1674 
	    warning("passing an object of type '%s' to .C (arg %d) is deprecated",
1675 
		    type2char(t), na + 1);
1676 
	    if (t == LISTSXP)
1677 
		warning(_("pairlists are passed as SEXP as from R 2.15.0"));
1678 
	    cargs[na] =  (void*) s;
58861 ripley 1679 
	    continue;
58855 ripley 1680 
	}
1681 
	if (nprotect) UNPROTECT(nprotect);
14156 duncan 1682 
    }
1683 
 
1839 ihaka 1684 
    switch (nargs) {
1685 
    case 0:
1686 
	/* Silicon graphics C chokes here */
1687 
	/* if there is no argument to fun. */
1688 
	fun(0);
1689 
	break;
1690 
    case 1:
1691 
	fun(cargs[0]);
1692 
	break;
1693 
    case 2:
1694 
	fun(cargs[0], cargs[1]);
1695 
	break;
1696 
    case 3:
1697 
	fun(cargs[0], cargs[1], cargs[2]);
1698 
	break;
1699 
    case 4:
1700 
	fun(cargs[0], cargs[1], cargs[2], cargs[3]);
1701 
	break;
1702 
    case 5:
1703 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4]);
1704 
	break;
1705 
    case 6:
1706 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1707 
	    cargs[5]);
1708 
	break;
1709 
    case 7:
1710 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1711 
	    cargs[5],  cargs[6]);
1712 
	break;
1713 
    case 8:
1714 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1715 
	    cargs[5],  cargs[6],  cargs[7]);
1716 
	break;
1717 
    case 9:
1718 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1719 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8]);
1720 
	break;
1721 
    case 10:
1722 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1723 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9]);
1724 
	break;
1725 
    case 11:
1726 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1727 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1728 
	    cargs[10]);
1729 
	break;
1730 
    case 12:
1731 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1732 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1733 
	    cargs[10], cargs[11]);
1734 
	break;
1735 
    case 13:
1736 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1737 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1738 
	    cargs[10], cargs[11], cargs[12]);
1739 
	break;
1740 
    case 14:
1741 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1742 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1743 
	    cargs[10], cargs[11], cargs[12], cargs[13]);
1744 
	break;
1745 
    case 15:
1746 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1747 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1748 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14]);
1749 
	break;
1750 
    case 16:
1751 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1752 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1753 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1754 
	    cargs[15]);
1755 
	break;
1756 
    case 17:
1757 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1758 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1759 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1760 
	    cargs[15], cargs[16]);
1761 
	break;
1762 
    case 18:
1763 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1764 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1765 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1766 
	    cargs[15], cargs[16], cargs[17]);
1767 
	break;
1768 
    case 19:
1769 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1770 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1771 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1772 
	    cargs[15], cargs[16], cargs[17], cargs[18]);
1773 
	break;
1774 
    case 20:
1775 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1776 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1777 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1778 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19]);
1779 
	break;
1780 
    case 21:
1781 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1782 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1783 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1784 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1785 
	    cargs[20]);
1786 
	break;
1787 
    case 22:
1788 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1789 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1790 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1791 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1792 
	    cargs[20], cargs[21]);
1793 
	break;
1794 
    case 23:
1795 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1796 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1797 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1798 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1799 
	    cargs[20], cargs[21], cargs[22]);
1800 
	break;
1801 
    case 24:
1802 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1803 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1804 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1805 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1806 
	    cargs[20], cargs[21], cargs[22], cargs[23]);
1807 
	break;
1808 
    case 25:
1809 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1810 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1811 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1812 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1813 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24]);
1814 
	break;
1815 
    case 26:
1816 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1817 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1818 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1819 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1820 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1821 
	    cargs[25]);
1822 
	break;
1823 
    case 27:
1824 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1825 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1826 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1827 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1828 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1829 
	    cargs[25], cargs[26]);
1830 
	break;
1831 
    case 28:
1832 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1833 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1834 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1835 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1836 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1837 
	    cargs[25], cargs[26], cargs[27]);
1838 
	break;
1839 
    case 29:
1840 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1841 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1842 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1843 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1844 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1845 
	    cargs[25], cargs[26], cargs[27], cargs[28]);
1846 
	break;
1847 
    case 30:
1848 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1849 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1850 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1851 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1852 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1853 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29]);
1854 
	break;
1855 
    case 31:
1856 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1857 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1858 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1859 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1860 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1861 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1862 
	    cargs[30]);
1863 
	break;
1864 
    case 32:
1865 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1866 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1867 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1868 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1869 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1870 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1871 
	    cargs[30], cargs[31]);
1872 
	break;
1873 
    case 33:
1874 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1875 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1876 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1877 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1878 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1879 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1880 
	    cargs[30], cargs[31], cargs[32]);
1881 
	break;
1882 
    case 34:
1883 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1884 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1885 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1886 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1887 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1888 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1889 
	    cargs[30], cargs[31], cargs[32], cargs[33]);
1890 
	break;
1891 
    case 35:
1892 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1893 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1894 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1895 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1896 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1897 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1898 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34]);
1899 
	break;
1900 
    case 36:
1901 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1902 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1903 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1904 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1905 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1906 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1907 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1908 
	    cargs[35]);
1909 
	break;
1910 
    case 37:
1911 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1912 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1913 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1914 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1915 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1916 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1917 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1918 
	    cargs[35], cargs[36]);
1919 
	break;
1920 
    case 38:
1921 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1922 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1923 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1924 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1925 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1926 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1927 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1928 
	    cargs[35], cargs[36], cargs[37]);
1929 
	break;
1930 
    case 39:
1931 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1932 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1933 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1934 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1935 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1936 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1937 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1938 
	    cargs[35], cargs[36], cargs[37], cargs[38]);
1939 
	break;
1940 
    case 40:
1941 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1942 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1943 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1944 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1945 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1946 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1947 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1948 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39]);
1949 
	break;
1950 
    case 41:
1951 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1952 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1953 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1954 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1955 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1956 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1957 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1958 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1959 
	    cargs[40]);
1960 
	break;
1961 
    case 42:
1962 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1963 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1964 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1965 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1966 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1967 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1968 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1969 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1970 
	    cargs[40], cargs[41]);
1971 
	break;
1972 
    case 43:
1973 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1974 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1975 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1976 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1977 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1978 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1979 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1980 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1981 
	    cargs[40], cargs[41], cargs[42]);
1982 
	break;
1983 
    case 44:
1984 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1985 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1986 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1987 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1988 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
1989 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
1990 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
1991 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
1992 
	    cargs[40], cargs[41], cargs[42], cargs[43]);
1993 
	break;
1994 
    case 45:
1995 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
1996 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
1997 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
1998 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
1999 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2000 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2001 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2002 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2003 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44]);
2004 
	break;
2005 
    case 46:
2006 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2007 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2008 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2009 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2010 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2011 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2012 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2013 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2014 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2015 
	    cargs[45]);
2016 
	break;
2017 
    case 47:
2018 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2019 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2020 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2021 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2022 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2023 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2024 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2025 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2026 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2027 
	    cargs[45], cargs[46]);
2028 
	break;
2029 
    case 48:
2030 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2031 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2032 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2033 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2034 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2035 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2036 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2037 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2038 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2039 
	    cargs[45], cargs[46], cargs[47]);
2040 
	break;
2041 
    case 49:
2042 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2043 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2044 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2045 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2046 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2047 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2048 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2049 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2050 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2051 
	    cargs[45], cargs[46], cargs[47], cargs[48]);
2052 
	break;
2053 
    case 50:
2054 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2055 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2056 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2057 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2058 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2059 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2060 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2061 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2062 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2063 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49]);
2064 
	break;
2065 
    case 51:
2066 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2067 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2068 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2069 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2070 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2071 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2072 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2073 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2074 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2075 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2076 
	    cargs[50]);
2077 
	break;
2078 
    case 52:
2079 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2080 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2081 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2082 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2083 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2084 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2085 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2086 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2087 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2088 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2089 
	    cargs[50], cargs[51]);
2090 
	break;
2091 
    case 53:
2092 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2093 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2094 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2095 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2096 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2097 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2098 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2099 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2100 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2101 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2102 
	    cargs[50], cargs[51], cargs[52]);
2103 
	break;
2104 
    case 54:
2105 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2106 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2107 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2108 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2109 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2110 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2111 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2112 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2113 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2114 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2115 
	    cargs[50], cargs[51], cargs[52], cargs[53]);
2116 
	break;
2117 
    case 55:
2118 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2119 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2120 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2121 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2122 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2123 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2124 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2125 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2126 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2127 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2128 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54]);
2129 
	break;
2130 
    case 56:
2131 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2132 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2133 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2134 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2135 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2136 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2137 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2138 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2139 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2140 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2141 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2142 
	    cargs[55]);
2143 
	break;
2144 
    case 57:
2145 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2146 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2147 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2148 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2149 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2150 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2151 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2152 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2153 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2154 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2155 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2156 
	    cargs[55], cargs[56]);
2157 
	break;
2158 
    case 58:
2159 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2160 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2161 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2162 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2163 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2164 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2165 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2166 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2167 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2168 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2169 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2170 
	    cargs[55], cargs[56], cargs[57]);
2171 
	break;
2172 
    case 59:
2173 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2174 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2175 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2176 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2177 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2178 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2179 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2180 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2181 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2182 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2183 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2184 
	    cargs[55], cargs[56], cargs[57], cargs[58]);
2185 
	break;
2186 
    case 60:
2187 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2188 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2189 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2190 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2191 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2192 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2193 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2194 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2195 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2196 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2197 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2198 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59]);
2199 
	break;
2200 
    case 61:
2201 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2202 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2203 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2204 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2205 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2206 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2207 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2208 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2209 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2210 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2211 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2212 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
2213 
	    cargs[60]);
2214 
	break;
2215 
    case 62:
2216 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2217 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2218 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2219 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2220 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2221 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2222 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2223 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2224 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2225 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2226 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2227 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
2228 
	    cargs[60], cargs[61]);
2229 
	break;
2230 
    case 63:
2231 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2232 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2233 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2234 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2235 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2236 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2237 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2238 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2239 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2240 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2241 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2242 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
2243 
	    cargs[60], cargs[61], cargs[62]);
2244 
	break;
2245 
    case 64:
2246 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2247 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2248 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2249 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2250 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2251 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2252 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2253 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2254 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2255 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2256 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2257 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
2258 
	    cargs[60], cargs[61], cargs[62], cargs[63]);
2259 
	break;
2260 
    case 65:
2261 
	fun(cargs[0],  cargs[1],  cargs[2],  cargs[3],  cargs[4],
2262 
	    cargs[5],  cargs[6],  cargs[7],  cargs[8],  cargs[9],
2263 
	    cargs[10], cargs[11], cargs[12], cargs[13], cargs[14],
2264 
	    cargs[15], cargs[16], cargs[17], cargs[18], cargs[19],
2265 
	    cargs[20], cargs[21], cargs[22], cargs[23], cargs[24],
2266 
	    cargs[25], cargs[26], cargs[27], cargs[28], cargs[29],
2267 
	    cargs[30], cargs[31], cargs[32], cargs[33], cargs[34],
2268 
	    cargs[35], cargs[36], cargs[37], cargs[38], cargs[39],
2269 
	    cargs[40], cargs[41], cargs[42], cargs[43], cargs[44],
2270 
	    cargs[45], cargs[46], cargs[47], cargs[48], cargs[49],
2271 
	    cargs[50], cargs[51], cargs[52], cargs[53], cargs[54],
2272 
	    cargs[55], cargs[56], cargs[57], cargs[58], cargs[59],
2273 
	    cargs[60], cargs[61], cargs[62], cargs[63], cargs[64]);
2274 
	break;
2275 
    default:
32867 ripley 2276 
	errorcall(call, _("too many arguments, sorry"));
1839 ihaka 2277 
    }
58854 ripley 2278 
 
1839 ihaka 2279 
    if (dup) {
58854 ripley 2280 
 
2281 
	for (na = 0, pa = args ; pa != R_NilValue ; pa = CDR(pa), na++) {
2282 
	    if(argStyles && argStyles[na] == R_ARG_IN) {
58861 ripley 2283 
		SET_VECTOR_ELT(ans, na, R_NilValue);
2284 
		continue;
14156 duncan 2285 
	    } else {
58854 ripley 2286 
		void *p = cargs[na];
2287 
		SEXP arg = CAR(pa);
58892 ripley 2288 
		s = VECTOR_ELT(ans, na);
58854 ripley 2289 
		R_NativePrimitiveArgType type =
58855 ripley 2290 
		    checkTypes ? checkTypes[na] : TYPEOF(arg);
59011 ripley 2291 
	        R_xlen_t n = xlength(arg);
58854 ripley 2292 
 
2293 
		switch(type) {
58916 ripley 2294 
		case RAWSXP:
58918 ripley 2295 
		    if (copy) {
2296 
			s = allocVector(type, n);
58930 ripley 2297 
			unsigned char *ptr = (unsigned char *) p;
2298 
			memcpy(RAW(s), ptr, n * sizeof(Rbyte));
2299 
			ptr += n * sizeof(Rbyte);
2300 
			for (int i = 0; i < NG; i++)
58918 ripley 2301 
			    if(*ptr++ != FILL)
2302 
				error("array over-run in %s(\"%s\") in %s argument %d\n",
2303 
				      Fort ? ".Fortran" : ".C",
2304 
				      symName, type2char(type), na+1);
58930 ripley 2305 
			ptr = (unsigned char *) p;
2306 
			for (int i = 0; i < NG; i++)
2307 
			    if(*--ptr != FILL)
2308 
				error("array under-run in %s(\"%s\") in %s argument %d\n",
2309 
				      Fort ? ".Fortran" : ".C",
2310 
				      symName, type2char(type), na+1);
58918 ripley 2311 
		    }
58916 ripley 2312 
		    break;
2313 
		case INTSXP:
58918 ripley 2314 
		    if (copy) {
2315 
			s = allocVector(type, n);
58930 ripley 2316 
			unsigned char *ptr = (unsigned char *) p;
2317 
			memcpy(INTEGER(s), ptr, n * sizeof(int));
2318 
			ptr += n * sizeof(int);
2319 
			for (int i = 0; i < NG; i++)
58918 ripley 2320 
			    if(*ptr++ != FILL)
58916 ripley 2321 
				error("array over-run in %s(\"%s\") in %s argument %d\n",
2322 
				      Fort ? ".Fortran" : ".C",
2323 
				      symName, type2char(type), na+1);
58930 ripley 2324 
			ptr = (unsigned char *) p;
2325 
			for (int i = 0; i < NG; i++)
2326 
			    if(*--ptr != FILL)
2327 
				error("array under-run in %s(\"%s\") in %s argument %d\n",
2328 
				      Fort ? ".Fortran" : ".C",
2329 
				      symName, type2char(type), na+1);
58916 ripley 2330 
		    }
2331 
		    break;
2332 
		case LGLSXP:
58918 ripley 2333 
		    if (copy) {
2334 
			s = allocVector(type, n);
58930 ripley 2335 
			unsigned char *ptr = (unsigned char *) p;
2336 
			int *iptr = (int*) ptr, tmp;
59011 ripley 2337 
			for (R_xlen_t i = 0 ; i < n ; i++) {
58918 ripley 2338 
			    tmp =  iptr[i];
2339 
			    LOGICAL(s)[i] = (tmp == NA_INTEGER || tmp == 0) ? tmp : 1;
2340 
			}
58930 ripley 2341 
			ptr += n * sizeof(int);
2342 
			for (int i = 0; i < NG;  i++)
58918 ripley 2343 
			    if(*ptr++ != FILL)
2344 
				error("array over-run in %s(\"%s\") in %s argument %d\n",
2345 
				      Fort ? ".Fortran" : ".C",
2346 
				      symName, type2char(type), na+1);
58930 ripley 2347 
			ptr = (unsigned char *) p;
2348 
			for (int i = 0; i < NG; i++)
2349 
			    if(*--ptr != FILL)
2350 
				error("array under-run in %s(\"%s\") in %s argument %d\n",
2351 
				      Fort ? ".Fortran" : ".C",
2352 
				      symName, type2char(type), na+1);
58918 ripley 2353 
		    } else {
2354 
			int *iptr = INTEGER(arg), tmp;
59011 ripley 2355 
			for (R_xlen_t i = 0 ; i < n ; i++) {
58918 ripley 2356 
			    tmp =  iptr[i];
2357 
			    iptr[i] = (tmp == NA_INTEGER || tmp == 0) ? tmp : 1;
2358 
			}
58854 ripley 2359 
		    }
2360 
		    break;
2361 
		case REALSXP:
2362 
		case SINGLESXP:
58918 ripley 2363 
		    if (copy) {
58892 ripley 2364 
			s = allocVector(REALSXP, n);
58918 ripley 2365 
			if (type == SINGLESXP || asLogical(getAttrib(arg, CSingSymbol)) == 1) {
2366 
			    float *sptr = (float*) p;
59011 ripley 2367 
			    for(R_xlen_t i = 0 ; i < n ; i++)
58918 ripley 2368 
				REAL(s)[i] = (double) sptr[i];
2369 
			} else {
58930 ripley 2370 
			    unsigned char *ptr = (unsigned char *) p;
2371 
			    memcpy(REAL(s), ptr, n * sizeof(double));
2372 
			    ptr += n * sizeof(double);
2373 
			    for (int i = 0; i < NG; i++)
58918 ripley 2374 
				if(*ptr++ != FILL)
2375 
				    error("array over-run in %s(\"%s\") in %s argument %d\n",
2376 
					  Fort ? ".Fortran" : ".C",
2377 
					  symName, type2char(type), na+1);
58954 ripley 2378 
			    ptr = (unsigned char *) p;
2379 
			    for (int i = 0; i < NG; i++)
2380 
				if(*--ptr != FILL)
2381 
				    error("array under-run in %s(\"%s\") in %s argument %d\n",
2382 
					  Fort ? ".Fortran" : ".C",
2383 
					  symName, type2char(type), na+1);
58918 ripley 2384 
			}
2385 
		    } else {
2386 
			if (type == SINGLESXP || asLogical(getAttrib(arg, CSingSymbol)) == 1) {
2387 
			    s = allocVector(REALSXP, n);
2388 
			    float *sptr = (float*) p;
2389 
			    for(int i = 0 ; i < n ; i++)
2390 
				REAL(s)[i] = (double) sptr[i];
2391 
			}
58892 ripley 2392 
		    }
58918 ripley 2393 
		    break;
2394 
		case CPLXSXP:
2395 
		    if (copy) {
2396 
			s = allocVector(type, n);
58930 ripley 2397 
			unsigned char *ptr = (unsigned char *) p;
2398 
			memcpy(COMPLEX(s), p, n * sizeof(Rcomplex));
2399 
			ptr += n * sizeof(Rcomplex);
2400 
			for (int i = 0; i < NG;  i++)
58918 ripley 2401 
			    if(*ptr++ != FILL)
2402 
				error("array over-run in %s(\"%s\") in %s argument %d\n",
2403 
				      Fort ? ".Fortran" : ".C",
2404 
				      symName, type2char(type), na+1);
58930 ripley 2405 
			ptr = (unsigned char *) p;
2406 
			for (int i = 0; i < NG; i++)
2407 
			    if(*--ptr != FILL)
2408 
				error("array under-run in %s(\"%s\") in %s argument %d\n",
2409 
				      Fort ? ".Fortran" : ".C",
2410 
				      symName, type2char(type), na+1);
58918 ripley 2411 
		    }
58854 ripley 2412 
		    break;
2413 
		case STRSXP:
2414 
		    if(Fort) {
2415 
			char buf[256];
2416 
			/* only return one string: warned on the R -> Fortran step */
2417 
			strncpy(buf, (char*)p, 255);
2418 
			buf[255] = '\0';
2419 
			PROTECT(s = allocVector(type, 1));
2420 
			SET_STRING_ELT(s, 0, mkChar(buf));
2421 
			UNPROTECT(1);
59132 ripley 2422 
		    } else if (copy) {
2423 
			SEXP ss = arg;
2424 
			PROTECT(s = allocVector(type, n));
2425 
			char **cptr = (char**) p, **cptr0 = (char**) cargs0[na];
2426 
			for (R_xlen_t i = 0 ; i < n ; i++) {
2427 
			    unsigned char *ptr = (unsigned char *) cptr[i];
2428 
			    SET_STRING_ELT(s, i, mkChar(cptr[i]));
2429 
			    if (cptr[i] == cptr0[i]) {
59139 ripley 2430 
				    const char *z = translateChar(STRING_ELT(ss, i));
2431 
				for (int j = 0; j < NG; j++)
59132 ripley 2432 
				    if(*--ptr != FILL)
59139 ripley 2433 
					error("array under-run in .C(\"%s\") in character argument %d, element %d",
2434 
					      symName, na+1, (int)(i+1));
59132 ripley 2435 
				ptr = (unsigned char *) cptr[i];
59139 ripley 2436 
				ptr += strlen(z) + 1;
2437 
				for (int j = 0; j < NG;  j++)
2438 
				    if(*ptr++ != FILL) {
2439 
					 // force termination
2440 
					unsigned char *p = ptr;
2441 
					for (int k = 1; k < NG - j; k++, p++)
2442 
					    if (*p == FILL) *p = '\0';
59136 ripley 2443 
					error("array over-run in .C(\"%s\") in character argument %d, element %d\n'%s'->'%s'\n",
59139 ripley 2444 
					      symName, na+1, (int)(i+1),
2445 
					      z, cptr[i]);
2446 
				    }
59132 ripley 2447 
			    }
2448 
			}
2449 
			UNPROTECT(1);
58854 ripley 2450 
		    } else {
2451 
			PROTECT(s = allocVector(type, n));
2452 
			char **cptr = (char**) p;
59011 ripley 2453 
			for (R_xlen_t i = 0 ; i < n ; i++)
58854 ripley 2454 
			    SET_STRING_ELT(s, i, mkChar(cptr[i]));
2455 
			UNPROTECT(1);
2456 
		    }
2457 
		    break;
2458 
		default:
58892 ripley 2459 
		    break;
58854 ripley 2460 
		}
58892 ripley 2461 
		if (s != arg) {
2462 
		    PROTECT(s);
2463 
		    DUPLICATE_ATTRIB(s, arg);
2464 
		    SET_VECTOR_ELT(ans, na, s);
2465 
		    UNPROTECT(1);
38550 tlumley 2466 
		}
14156 duncan 2467 
	    }
2 r 2468 
	}
1839 ihaka 2469 
    }
2470 
    UNPROTECT(1);
2471 
    vmaxset(vmax);
58854 ripley 2472 
    return ans;
1839 ihaka 2473 
}
2 r 2474 
 
58668 ripley 2475 
#ifndef NO_CALL_R
19912 duncan 2476 
static const struct {
2477 
    const char *name;
2478 
    const SEXPTYPE type;
2 r 2479 
}
58602 ripley 2480 
 
1839 ihaka 2481 
typeinfo[] = {
2482 
    {"logical",	  LGLSXP },
2483 
    {"integer",	  INTSXP },
2484 
    {"double",	  REALSXP},
2485 
    {"complex",	  CPLXSXP},
2486 
    {"character", STRSXP },
2487 
    {"list",	  VECSXP },
2488 
    {NULL,	  0      }
2 r 2489 
};
2490 
 
2491 
static int string2type(char *s)
2492 
{
1839 ihaka 2493 
    int i;
2494 
    for (i = 0 ; typeinfo[i].name ; i++) {
2495 
	if(!strcmp(typeinfo[i].name, s)) {
2496 
	    return typeinfo[i].type;
2 r 2497 
	}
1839 ihaka 2498 
    }
32867 ripley 2499 
    error(_("type \"%s\" not supported in interlanguage calls"), s);
1839 ihaka 2500 
    return 1; /* for -Wall */
2 r 2501 
}
2502 
 
58854 ripley 2503 
/* This is entirely legacy, with no known users (Mar 2012).
58663 ripley 2504 
   So we freeze the code involved.
2505 
 */
2506 
 
2507 
static void *RObjToCPtr2(SEXP s)
2508 
{
2509 
    int n;
2510 
 
2511 
    switch(TYPEOF(s)) {
2512 
    case LGLSXP:
2513 
    case INTSXP:
2514 
	n = LENGTH(s);
2515 
	int *iptr = INTEGER(s);
2516 
	iptr = (int*) R_alloc(n, sizeof(int));
2517 
	for (int i = 0 ; i < n ; i++) iptr[i] = INTEGER(s)[i];
2518 
	return (void*) iptr;
2519 
	break;
2520 
    case REALSXP:
2521 
	n = LENGTH(s);
2522 
	double *rptr = REAL(s);
2523 
	rptr = (double*) R_alloc(n, sizeof(double));
2524 
	for (int i = 0 ; i < n ; i++) rptr[i] = REAL(s)[i];
2525 
	return (void*) rptr;
2526 
	break;
2527 
    case CPLXSXP:
2528 
	n = LENGTH(s);
2529 
	Rcomplex *zptr = COMPLEX(s);
2530 
	zptr = (Rcomplex*) R_alloc(n, sizeof(Rcomplex));
2531 
	for (int i = 0 ; i < n ; i++) zptr[i] = COMPLEX(s)[i];
2532 
	return (void*) zptr;
2533 
	break;
2534 
    case STRSXP:
2535 
	n = LENGTH(s);
2536 
	char **cptr = (char**) R_alloc(n, sizeof(char*));
2537 
	for (int i = 0 ; i < n ; i++) {
2538 
	    const char *ss = translateChar(STRING_ELT(s, i));
2539 
	    cptr[i] = (char*) R_alloc(strlen(ss) + 1, sizeof(char));
2540 
	    strcpy(cptr[i], ss);
2541 
	}
2542 
	return (void*) cptr;
2543 
	break;
2544 
	/* From here down, probably not right */
2545 
    case VECSXP:
2546 
	n = length(s);
2547 
	SEXP *lptr = (SEXP *) R_alloc(n, sizeof(SEXP));
2548 
	for (int i = 0 ; i < n ; i++) lptr[i] = VECTOR_ELT(s, i);
2549 
	return (void*) lptr;
2550 
	break;
2551 
    default:
2552 
	return (void*) s;
2553 
    }
2554 
}
2555 
 
2556 
 
2557 
 
2 r 2558 
void call_R(char *func, long nargs, void **arguments, char **modes,
1839 ihaka 2559 
	    long *lengths, char **names, long nres, char **results)
2 r 2560 
{
1839 ihaka 2561 
    SEXP call, pcall, s;
2562 
    SEXPTYPE type;
2563 
    int i, j, n;
9317 ripley 2564 
 
1839 ihaka 2565 
    if (!isFunction((SEXP)func))
60844 ripley 2566 
	error("invalid function in call_R");
1839 ihaka 2567 
    if (nargs < 0)
60844 ripley 2568 
	error("invalid argument count in call_R");
1839 ihaka 2569 
    if (nres < 0)
60844 ripley 2570 
	error("invalid return value count in call_R");
59173 ripley 2571 
    PROTECT(pcall = call = allocList((int) nargs + 1));
10172 luke 2572 
    SET_TYPEOF(call, LANGSXP);
2573 
    SETCAR(pcall, (SEXP)func);
3865 pd 2574 
    s = R_NilValue;		/* -Wall */
1839 ihaka 2575 
    for (i = 0 ; i < nargs ; i++) {
2576 
	pcall = CDR(pcall);
2577 
	type = string2type(modes[i]);
2578 
	switch(type) {
2 r 2579 
	case LGLSXP:
2580 
	case INTSXP:
59173 ripley 2581 
	    n = (int) lengths[i];
10172 luke 2582 
	    SETCAR(pcall, allocVector(type, n));
2583 
	    memcpy(INTEGER(CAR(pcall)), arguments[i], n * sizeof(int));
1839 ihaka 2584 
	    break;
2 r 2585 
	case REALSXP:
59173 ripley 2586 
	    n = (int) lengths[i];
10172 luke 2587 
	    SETCAR(pcall, allocVector(REALSXP, n));
2588 
	    memcpy(REAL(CAR(pcall)), arguments[i], n * sizeof(double));
1839 ihaka 2589 
	    break;
2 r 2590 
	case CPLXSXP:
59173 ripley 2591 
	    n = (int) lengths[i];
10172 luke 2592 
	    SETCAR(pcall, allocVector(CPLXSXP, n));
2593 
	    memcpy(REAL(CAR(pcall)), arguments[i], n * sizeof(Rcomplex));
1839 ihaka 2594 
	    break;
2 r 2595 
	case STRSXP:
59173 ripley 2596 
	    n = (int) lengths[i];
10172 luke 2597 
	    SETCAR(pcall, allocVector(STRSXP, n));
2598 
	    for (j = 0 ; j < n ; j++) {
2599 
		char *str = (char*)(arguments[i]);
41495 rgentlem 2600 
		SET_STRING_ELT(CAR(pcall), i, mkChar(str));
45446 ripley 2601 
	    }
1839 ihaka 2602 
	    break;
9317 ripley 2603 
	default:
33297 ripley 2604 
	    error(_("mode '%s' is not supported in call_R"), modes[i]);
2 r 2605 
	}
1839 ihaka 2606 
	if(names && names[i])
10172 luke 2607 
	    SET_TAG(pcall, install(names[i]));
2608 
	SET_NAMED(CAR(pcall), 2);
1839 ihaka 2609 
    }
2610 
    PROTECT(s = eval(call, R_GlobalEnv));
2611 
    switch(TYPEOF(s)) {
2612 
    case LGLSXP:
2613 
    case INTSXP:
2614 
    case REALSXP:
2615 
    case CPLXSXP:
2616 
    case STRSXP:
2617 
	if(nres > 0)
58663 ripley 2618 
	    results[0] = (char *) RObjToCPtr2(s);
1839 ihaka 2619 
	break;
2620 
    case VECSXP:
2621 
	n = length(s);
59173 ripley 2622 
	if (nres < n) n = (int) nres;
58663 ripley 2623 
	for (i = 0 ; i < n ; i++)
2624 
	    results[i] = (char *) RObjToCPtr2(VECTOR_ELT(s, i));
1839 ihaka 2625 
	break;
2626 
    case LISTSXP:
2627 
	n = length(s);
59173 ripley 2628 
	if(nres < n) n = (int) nres;
58602 ripley 2629 
	for(i = 0 ; i < n ; i++) {
58663 ripley 2630 
	    results[i] = (char *) RObjToCPtr2(s);
1839 ihaka 2631 
	    s = CDR(s);
2632 
	}
2633 
	break;
2634 
    }
2635 
    UNPROTECT(2);
2636 
    return;
2 r 2637 
}
2638 
 
2639 
void call_S(char *func, long nargs, void **arguments, char **modes,
1839 ihaka 2640 
	    long *lengths, char **names, long nres, char **results)
2 r 2641 
{
1839 ihaka 2642 
    call_R(func, nargs, arguments, modes, lengths, names, nres, results);
2 r 2643 
}
58668 ripley 2644 
#endif