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