remove scm_tc7_gsubr

* libguile/tags.h (scm_tc7_gsubr): Return to the pool of unused tc7s, as
  there are no more gsubrs. Yay :)

* libguile/programs.h (SCM_F_PROGRAM_IS_PRIMITIVE):
  (SCM_PROGRAM_IS_PRIMITIVE): New flag and accessor.

* libguile/gsubr.c (create_gsubr):
* libguile/snarf.h (SCM_STATIC_PROGRAM): Give subrs a PRIMITIVE flag.

* libguile/smob.h:
* libguile/smob.c (scm_i_smob_arity): New internal procedure. Uses the
  old GSUBR type macros, local to the file.

* libguile/procprop.c (scm_i_procedure_arity): Call out to
  scm_i_smob_arity, and remove a gsubr case.

* libguile/gc.c (scm_i_tag_name):
* libguile/evalext.c (scm_self_evaluating_p):
* libguile/goops.c (scm_class_of):
* libguile/vm.c (apply_foreign):
* libguile/hash.c (scm_hasher):
* libguile/debug.c (scm_procedure_name):
* libguile/print.c (iprin1): Remove gsubr cases.

* libguile/gsubr.h (SCM_PRIMITIVE_P): Fix to work with the new VM
  program regimen.
  (SCM_GSUBR_TYPE, SCM_GSUBR_MAKTYPE, SCM_GSUBR_MAX, SCM_GSUBR_REQ)
  (SCM_GSUBR_OPT, SCM_GSUBR_REST): Remove these macros, that are no
  longer useful.
* libguile/gsubr.c (scm_i_gsubr_apply, scm_i_gsubr_apply_list)
  (scm_i_gsubr_apply_array): Remove internal gsubr application
  functions.

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)) {
+  name = scm_procedure_property (proc, scm_sym_name);
-  case scm_tc7_gsubr:
+  if (scm_is_false (name) && SCM_PROGRAM_P (proc))
-    return SCM_SUBR_NAME (proc);
+    name = scm_program_name (proc);
-  default:
+  return name;
-    {
-      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;
-    }
-  }
 }
 #undef FUNC_NAME
 

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:

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;

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));
 
 /******************************************************************************
  *

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

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 */

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_program:
-    case scm_tc7_gsubr:
       return 262 % n;
     }
   }

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);

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))
+      return scm_i_smob_arity (proc, req, opt, rest);
-	{
-	  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;
-      }
     case scm_tcs_struct:
       if (!SCM_STRUCT_APPLICABLE_P (proc))
         return 0;

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)) {
+  name = scm_procedure_property (procedure, scm_sym_name);
-  case scm_tc7_gsubr:
-    name = SCM_SUBR_NAME (procedure);
-    break;
-  default:
-    name = scm_procedure_property (procedure, scm_sym_name);
-    break;
-  }
   if (scm_is_true (name))
     scm_set_procedure_property_x (ret, scm_sym_name, name);
   return ret;

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);

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 ()

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 */

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)

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

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);