1 |
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. |
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. |
2 |
* |
* |
3 |
* This program is free software; you can redistribute it and/or modify |
* This program is free software; you can redistribute it and/or modify |
4 |
* it under the terms of the GNU General Public License as published by |
* it under the terms of the GNU General Public License as published by |
5 |
* the Free Software Foundation; either version 2, or (at your option) |
* the Free Software Foundation; either version 2, or (at your option) |
6 |
* any later version. |
* any later version. |
7 |
* |
* |
8 |
* This program is distributed in the hope that it will be useful, |
* This program is distributed in the hope that it will be useful, |
9 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
10 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
11 |
* GNU General Public License for more details. |
* GNU General Public License for more details. |
12 |
* |
* |
13 |
* You should have received a copy of the GNU General Public License |
* You should have received a copy of the GNU General Public License |
14 |
* along with this software; see the file COPYING. If not, write to |
* along with this software; see the file COPYING. If not, write to |
15 |
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
62 |
SCM scm_f_gsubr_apply; |
SCM scm_f_gsubr_apply; |
63 |
|
|
64 |
static SCM |
static SCM |
65 |
create_gsubr (int define, const char *name, |
create_gsubr (int define, const char *name, |
66 |
int req, int opt, int rst, SCM (*fcn)()) |
int req, int opt, int rst, SCM (*fcn)()) |
67 |
{ |
{ |
68 |
SCM subr; |
SCM subr; |
103 |
SCM sym = SCM_SUBR_ENTRY(subr).name; |
SCM sym = SCM_SUBR_ENTRY(subr).name; |
104 |
if (SCM_GSUBR_MAX < req + opt + rst) |
if (SCM_GSUBR_MAX < req + opt + rst) |
105 |
{ |
{ |
106 |
fputs ("ERROR in scm_c_make_gsubr: too many args\n", stderr); |
fprintf (stderr, |
107 |
|
"ERROR in scm_c_make_gsubr: too many args (%d) to %s\n", |
108 |
|
req + opt + rst, name); |
109 |
exit (1); |
exit (1); |
110 |
} |
} |
111 |
SCM_SET_GSUBR_PROC (cclo, subr); |
SCM_SET_GSUBR_PROC (cclo, subr); |
217 |
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); |
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); |
218 |
#if 0 |
#if 0 |
219 |
if (n > SCM_GSUBR_MAX) |
if (n > SCM_GSUBR_MAX) |
220 |
scm_misc_error (FUNC_NAME, |
scm_misc_error (FUNC_NAME, |
221 |
"Function ~S has illegal arity ~S.", |
"Function ~S has illegal arity ~S.", |
222 |
scm_list_2 (self, SCM_MAKINUM (n))); |
scm_list_2 (self, SCM_MAKINUM (n))); |
223 |
#endif |
#endif |
224 |
args = SCM_CDR (args); |
args = SCM_CDR (args); |
260 |
|
|
261 |
#ifdef GSUBR_TEST |
#ifdef GSUBR_TEST |
262 |
/* A silly example, taking 2 required args, 1 optional, and |
/* A silly example, taking 2 required args, 1 optional, and |
263 |
a scm_list of rest args |
a scm_list of rest args |
264 |
*/ |
*/ |
265 |
SCM |
SCM |
266 |
gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst) |
gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst) |