move subr implementation details to gsubr.[ch]

* libguile/procs.h: Move subr macros to gsubr.h.
* libguile/procs.c (scm_c_make_subr, scm_c_make_subr_with_generic)
  (scm_c_define_subr, scm_c_define_subr_with_generic): Remove these,
  because they deal in subr types, and now there is only one subr type.
  The body of this code is now in gsubr.c.

* libguile/deprecated.h (scm_subr_p): Remove from procs.[ch] and define
  as a deprecated macro. Only used internally, but who knows who's out
  there.

* libguile/goops.c (scm_generic_capability_p)
  (scm_enable_primitive_generic_x, scm_set_primitive_generic_x)
  (scm_primitive_generic_generic): Use the new SCM_PRIMITIVE_GENERIC_P
  macro instead of calling scm_subr_p.

* libguile/gsubr.h (SCM_PRIMITIVE_P, SCM_PRIMITIVE_GENERIC_P): New
  macros, to replace scm_subr_p and hacky checking for generic
  capability.
  (SCM_SUBR_META_INFO, SCM_SUBR_NAME, SCM_SUBRF, SCM_SUBR_PROPS)
  (SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC)
  (SCM_SUBR_ARITY_TO_TYPE): Moved here from procs.h.

* libguile/gsubr.c (create_gsubr): Inline the
  scm_c_make_subr definition here, and work for generics too. Removed a
  scm_remember_upto_here_1 that was added earlier in the year when
  meta_info was not being traced by the GC. Adapt callers.

1 files changed, 17 insertions, 35 deletions

diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 24ba6700c..70be51b91 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -48,9 +48,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
 static SCM
 create_gsubr (int define, const char *name,
 	      unsigned int req, unsigned int opt, unsigned int rst,
-	      SCM (*fcn) ())
+	      SCM (*fcn) (), SCM *generic_loc)
 {
   SCM subr;
+  SCM sname;
+  SCM *meta_info;
   unsigned type;
 
   type = SCM_GSUBR_MAKTYPE (req, opt, rst);
@@ -59,11 +61,18 @@ create_gsubr (int define, const char *name,
       || SCM_GSUBR_REST (type) != rst)
     scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
 
-  subr = scm_c_make_subr (name, scm_tc7_gsubr | (type << 8U),
-                          fcn);
+  meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info");
+  sname = scm_from_locale_symbol (name);
+  meta_info[0] = sname;
+  meta_info[1] = SCM_EOL;  /* properties */
+
+  subr = scm_double_cell ((scm_t_bits) scm_tc7_gsubr | (type << 8U),
+                          (scm_t_bits) fcn,
+                          (scm_t_bits) generic_loc,
+                          (scm_t_bits) meta_info);
 
   if (define)
-    scm_define (SCM_SUBR_NAME (subr), subr);
+    scm_define (sname, subr);
 
   return subr;
 }
@@ -71,40 +80,13 @@ create_gsubr (int define, const char *name,
 SCM
 scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
 {
-  return create_gsubr (0, name, req, opt, rst, fcn);
+  return create_gsubr (0, name, req, opt, rst, fcn, NULL);
 }
 
 SCM
 scm_c_define_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
 {
-  return create_gsubr (1, name, req, opt, rst, fcn);
-}
-
-static SCM
-create_gsubr_with_generic (int define,
-			   const char *name,
-			   int req,
-			   int opt,
-			   int rst,
-			   SCM (*fcn)(),
-			   SCM *gf)
-{
-  SCM subr;
-  unsigned type;
-
-  type = SCM_GSUBR_MAKTYPE (req, opt, rst);
-  if (SCM_GSUBR_REQ (type) != req
-      || SCM_GSUBR_OPT (type) != opt
-      || SCM_GSUBR_REST (type) != rst)
-    scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
-
-  subr = scm_c_make_subr_with_generic (name, scm_tc7_gsubr | (type << 8U),
-                                       fcn, gf);
-
-  if (define)
-    scm_define (SCM_SUBR_NAME (subr), subr);
-
-  return subr;
+  return create_gsubr (1, name, req, opt, rst, fcn, NULL);
 }
 
 SCM
@@ -115,7 +97,7 @@ scm_c_make_gsubr_with_generic (const char *name,
 			       SCM (*fcn)(),
 			       SCM *gf)
 {
-  return create_gsubr_with_generic (0, name, req, opt, rst, fcn, gf);
+  return create_gsubr (0, name, req, opt, rst, fcn, gf);
 }
 
 SCM
@@ -126,7 +108,7 @@ scm_c_define_gsubr_with_generic (const char *name,
 				 SCM (*fcn)(),
 				 SCM *gf)
 {
-  return create_gsubr_with_generic (1, name, req, opt, rst, fcn, gf);
+  return create_gsubr (1, name, req, opt, rst, fcn, gf);
 }
 
 /* Apply PROC, a gsubr, to the ARGC arguments in ARGV.  ARGC is expected to