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.

1 files changed, 2 insertions, 181 deletions

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