The R Project SVN R

Rev

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