summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/debug.c17
-rw-r--r--libguile/evalext.c1
-rw-r--r--libguile/gc.c3
-rw-r--r--libguile/goops.c9
-rw-r--r--libguile/gsubr.c183
-rw-r--r--libguile/gsubr.h17
-rw-r--r--libguile/hash.c5
-rw-r--r--libguile/print.c11
-rw-r--r--libguile/procprop.c19
-rw-r--r--libguile/procs.c10
-rw-r--r--libguile/programs.h2
-rw-r--r--libguile/smob.c24
-rw-r--r--libguile/smob.h4
-rw-r--r--libguile/snarf.h2
-rw-r--r--libguile/tags.h2
-rw-r--r--libguile/vm.c2
16 files changed, 46 insertions, 265 deletions
diff --git a/libguile/debug.c b/libguile/debug.c
index 852ff6742..1c86c76c0 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -137,20 +137,15 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
"Return the name of the procedure @var{proc}")
#define FUNC_NAME s_scm_procedure_name
{
+ SCM name;
+
SCM_VALIDATE_PROC (1, proc);
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
proc = SCM_STRUCT_PROCEDURE (proc);
- switch (SCM_TYP7 (proc)) {
- case scm_tc7_gsubr:
- return SCM_SUBR_NAME (proc);
- default:
- {
- SCM name = scm_procedure_property (proc, scm_sym_name);
- if (scm_is_false (name) && SCM_PROGRAM_P (proc))
- name = scm_program_name (proc);
- return name;
- }
- }
+ name = scm_procedure_property (proc, scm_sym_name);
+ if (scm_is_false (name) && SCM_PROGRAM_P (proc))
+ name = scm_program_name (proc);
+ return name;
}
#undef FUNC_NAME
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 5b86a918d..be775a8e1 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -90,7 +90,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
case scm_tc7_smob:
case scm_tc7_program:
case scm_tc7_bytevector:
- case scm_tc7_gsubr:
case scm_tcs_struct:
return SCM_BOOL_T;
default:
diff --git a/libguile/gc.c b/libguile/gc.c
index 4c898bcba..700f3a41c 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -797,9 +797,6 @@ scm_i_tag_name (scm_t_bits tag)
case scm_tc7_variable:
return "variable";
break;
- case scm_tc7_gsubr:
- return "gsubr";
- break;
case scm_tc7_port:
return "port";
break;
diff --git a/libguile/goops.c b/libguile/goops.c
index 97129851b..87ae99336 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -248,11 +248,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc16_fraction:
return scm_class_fraction;
}
- case scm_tc7_gsubr:
- if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
- return scm_class_primitive_generic;
- else
- return scm_class_procedure;
case scm_tc7_program:
if (SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x) && *SCM_SUBR_GENERIC (x))
return scm_class_primitive_generic;
@@ -2048,7 +2043,9 @@ scm_sys_compute_applicable_methods (SCM gf, SCM args)
#undef FUNC_NAME
SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
-SCM_VARIABLE_INIT (var_compute_applicable_methods, "compute-applicable-methods", scm_c_define_gsubr (s_sys_compute_applicable_methods, 2, 0, 0, scm_sys_compute_applicable_methods));
+SCM_VARIABLE_INIT (var_compute_applicable_methods, "compute-applicable-methods",
+ scm_c_define_gsubr (s_sys_compute_applicable_methods, 2, 0, 0,
+ scm_sys_compute_applicable_methods));
/******************************************************************************
*
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index becbe88d2..f0c622290 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -21,8 +21,6 @@
# include <config.h>
#endif
-#include <alloca.h>
-
#include <stdio.h>
#include <stdarg.h>
@@ -809,7 +807,8 @@ create_gsubr (int define, const char *name,
table, SCM_BOOL_F);
/* set flags */
- flags = generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
+ flags = SCM_F_PROGRAM_IS_PRIMITIVE;
+ flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
SCM_SET_CELL_WORD_0 (ret, SCM_CELL_WORD_0 (ret) | flags);
/* define, if needed */
@@ -854,184 +853,6 @@ scm_c_define_gsubr_with_generic (const char *name,
return create_gsubr (1, name, req, opt, rst, fcn, gf);
}
-/* Apply PROC, a gsubr, to the ARGC arguments in ARGV. ARGC is expected to
- match the number of arguments of the underlying C function. */
-static SCM
-gsubr_apply_raw (SCM proc, unsigned int argc, const SCM *argv)
-{
- SCM (*fcn) ();
- unsigned int type, argc_max;
-
- type = SCM_GSUBR_TYPE (proc);
- argc_max = SCM_GSUBR_REQ (type) + SCM_GSUBR_OPT (type)
- + SCM_GSUBR_REST (type);
-
- if (SCM_UNLIKELY (argc != argc_max))
- /* We expect the exact argument count. */
- scm_wrong_num_args (SCM_SUBR_NAME (proc));
-
- fcn = SCM_SUBRF (proc);
-
- switch (argc)
- {
- case 0:
- return (*fcn) ();
- case 1:
- return (*fcn) (argv[0]);
- case 2:
- return (*fcn) (argv[0], argv[1]);
- case 3:
- return (*fcn) (argv[0], argv[1], argv[2]);
- case 4:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3]);
- case 5:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4]);
- case 6:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
- case 7:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
- argv[6]);
- case 8:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
- argv[6], argv[7]);
- case 9:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
- argv[6], argv[7], argv[8]);
- case 10:
- return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
- argv[6], argv[7], argv[8], argv[9]);
- default:
- scm_misc_error ((char *) SCM_SUBR_NAME (proc),
- "gsubr invocation with more than 10 arguments not implemented",
- SCM_EOL);
- }
-
- return SCM_BOOL_F; /* Never reached. */
-}
-
-/* Apply PROC, a gsubr, to the given arguments. Missing optional arguments
- are added, and rest arguments are turned into a list. */
-SCM
-scm_i_gsubr_apply (SCM proc, SCM arg, ...)
-{
- unsigned int type, argc, argc_max;
- SCM *argv;
- va_list arg_list;
-
- type = SCM_GSUBR_TYPE (proc);
- argc_max = SCM_GSUBR_REQ (type) + SCM_GSUBR_OPT (type);
- argv = alloca ((argc_max + SCM_GSUBR_REST (type)) * sizeof (*argv));
-
- va_start (arg_list, arg);
-
- for (argc = 0;
- !SCM_UNBNDP (arg) && argc < argc_max;
- argc++, arg = va_arg (arg_list, SCM))
- argv[argc] = arg;
-
- if (SCM_UNLIKELY (argc < SCM_GSUBR_REQ (type)))
- /* too few args */
- scm_wrong_num_args (SCM_SUBR_NAME (proc));
- if (SCM_UNLIKELY (!SCM_UNBNDP (arg) && !SCM_GSUBR_REST (type)))
- /* too many args */
- scm_wrong_num_args (SCM_SUBR_NAME (proc));
-
- /* Fill in optional arguments that were not passed. */
- while (argc < argc_max)
- argv[argc++] = SCM_UNDEFINED;
-
- if (SCM_GSUBR_REST (type))
- {
- /* Accumulate rest arguments in a list. */
- SCM *rest_loc;
-
- argv[argc_max] = SCM_EOL;
-
- for (rest_loc = &argv[argc_max];
- !SCM_UNBNDP (arg);
- rest_loc = SCM_CDRLOC (*rest_loc), arg = va_arg (arg_list, SCM))
- *rest_loc = scm_cons (arg, SCM_EOL);
-
- argc = argc_max + 1;
- }
-
- va_end (arg_list);
-
- return gsubr_apply_raw (proc, argc, argv);
-}
-
-/* Apply SELF, a gsubr, to the arguments listed in ARGS. Missing optional
- arguments are added, and rest arguments are kept into a list. */
-SCM
-scm_i_gsubr_apply_list (SCM self, SCM args)
-#define FUNC_NAME "scm_i_gsubr_apply"
-{
- SCM v[SCM_GSUBR_MAX];
- unsigned int typ = SCM_GSUBR_TYPE (self);
- long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
-
- for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
- if (scm_is_null (args))
- scm_wrong_num_args (SCM_SUBR_NAME (self));
- v[i] = SCM_CAR(args);
- args = SCM_CDR(args);
- }
- for (; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++) {
- if (SCM_NIMP (args)) {
- v[i] = SCM_CAR (args);
- args = SCM_CDR(args);
- }
- else
- v[i] = SCM_UNDEFINED;
- }
- if (SCM_GSUBR_REST(typ))
- v[i] = args;
- else if (!scm_is_null (args))
- scm_wrong_num_args (SCM_SUBR_NAME (self));
-
- return gsubr_apply_raw (self, n, v);
-}
-#undef FUNC_NAME
-
-/* Apply SELF, a gsubr, to the arguments in ARGS. Missing optional
- arguments are added, and rest arguments are consed into a list. */
-SCM
-scm_i_gsubr_apply_array (SCM self, SCM *args, int nargs, int headroom)
-#define FUNC_NAME "scm_i_gsubr_apply"
-{
- unsigned int typ = SCM_GSUBR_TYPE (self);
- long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
-
- if (SCM_UNLIKELY (nargs < SCM_GSUBR_REQ (typ)))
- scm_wrong_num_args (SCM_SUBR_NAME (self));
-
- if (SCM_UNLIKELY (headroom < n - nargs))
- {
- /* fallback on apply-list */
- SCM arglist = SCM_EOL;
- while (nargs--)
- arglist = scm_cons (args[nargs], arglist);
- return scm_i_gsubr_apply_list (self, arglist);
- }
-
- for (i = nargs; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++)
- args[i] = SCM_UNDEFINED;
-
- if (SCM_GSUBR_REST(typ))
- {
- SCM rest = SCM_EOL;
- /* fallback on apply-list */
- while (nargs-- >= n)
- rest = scm_cons (args[nargs], rest);
- args[n - 1] = rest;
- }
- else if (nargs > n)
- scm_wrong_num_args (SCM_SUBR_NAME (self));
-
- return gsubr_apply_raw (self, n, args);
-}
-#undef FUNC_NAME
-
#ifdef GSUBR_TEST
/* A silly example, taking 2 required args, 1 optional, and
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 0f9d2acd9..be83a97b6 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -37,7 +37,7 @@ SCM_API SCM scm_subr_objcode_trampoline (unsigned int nreq,
/* Subrs
*/
-#define SCM_PRIMITIVE_P(x) (SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_gsubr)
+#define SCM_PRIMITIVE_P(x) (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE (x))
#define SCM_PRIMITIVE_GENERIC_P(x) (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x))
#define SCM_SUBRF(x) ((SCM (*)()) (SCM_FOREIGN_OBJECT (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 0), void*)))
@@ -49,17 +49,6 @@ SCM_API SCM scm_subr_objcode_trampoline (unsigned int nreq,
-/* Return an integer describing the arity of GSUBR, a subr of type
- `scm_tc7_gsubr'. The result can be interpreted with `SCM_GSUBR_REQ ()'
- and similar. */
-#define SCM_GSUBR_TYPE(gsubr) (SCM_CELL_TYPE (gsubr) >> 8)
-
-#define SCM_GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
-#define SCM_GSUBR_MAX 33
-#define SCM_GSUBR_REQ(x) ((long)(x)&0xf)
-#define SCM_GSUBR_OPT(x) (((long)(x)&0xf0)>>4)
-#define SCM_GSUBR_REST(x) ((long)(x)>>8)
-
SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, SCM (*fcn) ());
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
@@ -71,10 +60,6 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
int req, int opt, int rst,
SCM (*fcn) (), SCM *gf);
-SCM_INTERNAL SCM scm_i_gsubr_apply (SCM proc, SCM arg, ...);
-SCM_INTERNAL SCM scm_i_gsubr_apply_list (SCM proc, SCM args);
-SCM_INTERNAL SCM scm_i_gsubr_apply_array (SCM proc, SCM *args, int nargs,
- int headroom);
SCM_INTERNAL void scm_init_gsubr (void);
#endif /* SCM_GSUBR_H */
diff --git a/libguile/hash.c b/libguile/hash.c
index e56fab0b6..d2ce57586 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -169,8 +169,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
else return 1;
case scm_tc7_port:
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
- /* case scm_tcs_closures: */
- case scm_tc7_gsubr:
+ case scm_tc7_program:
return 262 % n;
}
}
diff --git a/libguile/print.c b/libguile/print.c
index 715037b67..aef575d80 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -789,17 +789,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
}
EXIT_NESTED_DATA (pstate);
break;
- case scm_tc7_gsubr:
- {
- SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
- scm_puts (SCM_SUBR_GENERIC (exp)
- ? "#<primitive-generic "
- : "#<primitive-procedure ",
- port);
- scm_lfwrite_str (name, port);
- scm_putc ('>', port);
- break;
- }
case scm_tc7_port:
{
register long i = SCM_PTOBNUM (exp);
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 24d65dce7..641defc49 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -56,24 +56,7 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
case scm_tc7_program:
return scm_i_program_arity (proc, req, opt, rest);
case scm_tc7_smob:
- if (SCM_SMOB_APPLICABLE_P (proc))
- {
- int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type;
- *req = SCM_GSUBR_REQ (type);
- *opt = SCM_GSUBR_OPT (type);
- *rest = SCM_GSUBR_REST (type);
- return 1;
- }
- else
- return 0;
- case scm_tc7_gsubr:
- {
- unsigned int type = SCM_GSUBR_TYPE (proc);
- *req = SCM_GSUBR_REQ (type);
- *opt = SCM_GSUBR_OPT (type);
- *rest = SCM_GSUBR_REST (type);
- return 1;
- }
+ return scm_i_smob_arity (proc, req, opt, rest);
case scm_tcs_struct:
if (!SCM_STRUCT_APPLICABLE_P (proc))
return 0;
diff --git a/libguile/procs.c b/libguile/procs.c
index e94037828..10ae8855f 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -53,7 +53,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
if (!((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC)
|| SCM_STRUCT_APPLICABLE_P (obj)))
break;
- case scm_tc7_gsubr:
case scm_tc7_program:
return SCM_BOOL_T;
case scm_tc7_smob:
@@ -125,14 +124,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
/* don't use procedure_name, because don't care enough to do a reverse
lookup */
- switch (SCM_TYP7 (procedure)) {
- case scm_tc7_gsubr:
- name = SCM_SUBR_NAME (procedure);
- break;
- default:
- name = scm_procedure_property (procedure, scm_sym_name);
- break;
- }
+ name = scm_procedure_property (procedure, scm_sym_name);
if (scm_is_true (name))
scm_set_procedure_property_x (ret, scm_sym_name, name);
return ret;
diff --git a/libguile/programs.h b/libguile/programs.h
index 0ae5bfe9c..61b76a9bf 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -27,6 +27,7 @@
*/
#define SCM_F_PROGRAM_IS_BOOT 0x100
+#define SCM_F_PROGRAM_IS_PRIMITIVE 0x100
#define SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC 0x200
#define SCM_PROGRAM_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
@@ -36,6 +37,7 @@
#define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
#define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
+#define SCM_PROGRAM_IS_PRIMITIVE(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_PRIMITIVE)
#define SCM_PROGRAM_IS_PRIMITIVE_GENERIC(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC)
SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
diff --git a/libguile/smob.c b/libguile/smob.c
index d96a0439c..037164bc2 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -17,6 +17,13 @@
*/
+#define SCM_GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
+#define SCM_GSUBR_MAX 33
+#define SCM_GSUBR_REQ(x) ((long)(x)&0xf)
+#define SCM_GSUBR_OPT(x) (((long)(x)&0xf0)>>4)
+#define SCM_GSUBR_REST(x) ((long)(x)>>8)
+
+
#ifdef HAVE_CONFIG_H
# include <config.h>
@@ -586,6 +593,21 @@ scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
free_smob (smob);
}
+int
+scm_i_smob_arity (SCM proc, int *req, int *opt, int *rest)
+{
+ if (SCM_SMOB_APPLICABLE_P (proc))
+ {
+ int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type;
+ *req = SCM_GSUBR_REQ (type);
+ *opt = SCM_GSUBR_OPT (type);
+ *rest = SCM_GSUBR_REST (type);
+ return 1;
+ }
+ else
+ return 0;
+}
+
void
scm_smob_prehistory ()
diff --git a/libguile/smob.h b/libguile/smob.h
index f9b511066..a79c39c9c 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -3,7 +3,7 @@
#ifndef SCM_SMOB_H
#define SCM_SMOB_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -217,6 +217,8 @@ SCM_API void scm_assert_smob_type (scm_t_bits tag, SCM val);
SCM_API SCM scm_make_smob (scm_t_bits tc);
+SCM_INTERNAL int scm_i_smob_arity (SCM proc, int *req, int *opt, int *rest);
+
SCM_API void scm_smob_prehistory (void);
#endif /* SCM_SMOB_H */
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 5b5a19bff..717c953e8 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -380,7 +380,7 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
#define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \
SCM_STATIC_DOUBLE_CELL (c_name, \
- scm_tc7_program, \
+ scm_tc7_program | (SCM_F_PROGRAM_IS_PRIMITIVE<<8), \
(scm_t_bits) objcode, \
(scm_t_bits) objtable, \
(scm_t_bits) freevars)
diff --git a/libguile/tags.h b/libguile/tags.h
index 64a870eac..143a3000a 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -422,7 +422,7 @@ typedef scm_t_uintptr scm_t_bits;
#define scm_tc7_vm_cont 71
#define scm_tc7_unused_17 61
-#define scm_tc7_gsubr 63
+#define scm_tc7_unused_21 63
#define scm_tc7_unused_19 69
#define scm_tc7_program 79
#define scm_tc7_unused_9 85
diff --git a/libguile/vm.c b/libguile/vm.c
index 07cdbc088..0da915bc3 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -299,8 +299,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
return SCM_SMOB_APPLY_3 (proc, args[0], args[1], arglist);
}
}
- case scm_tc7_gsubr:
- return scm_i_gsubr_apply_array (proc, args, nargs, headroom);
default:
badproc:
scm_wrong_type_arg ("apply", SCM_ARG1, proc);