Use double-cells to store subrs.

* libguile/procs.c (scm_subr_table, scm_subr_table_size,
  scm_subr_table_room, subr_table_gc_hint, scm_init_subr_table,
  scm_mark_subr_table): Remove.
  (scm_c_make_subr): Simply return a double-cell, with the procedure
  name and properties stored in a two-element array.
  (scm_free_subr_entry): Free the meta-info slot.

* libguile/init.c (scm_i_init_guile): Remove call to
  `scm_init_subr_table ()'.

* libguile/procs.h (SCM_SUBR_META_INFO): New macro.
  (SCM_SNAME, SCM_SUBR_PROPS): Use it.
  (SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC):
  Update.
  (scm_t_subr_entry, SCM_SUBR_ENTRY, SCM_SUBRNUM, scm_subr_table,
  scm_mark_subr_table, scm_init_subr_table): Remove.

4 files changed, 21 insertions, 79 deletions

diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index 9afafbac3..e73f6e10e 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2009 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
@@ -99,8 +99,6 @@ scm_mark_all (void)
 	  }
       }
   }
-  
-  scm_mark_subr_table ();
 
   loops = 0;
   while (1)
diff --git a/libguile/init.c b/libguile/init.c
index 522bec901..60c83c5fb 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 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
@@ -444,7 +444,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   
   scm_struct_prehistory ();	  /* requires storage */
   scm_symbols_prehistory ();      /* requires storage */
-  scm_init_subr_table ();
 #if 0
   scm_environments_prehistory (); /* requires storage */
 #endif
diff --git a/libguile/procs.c b/libguile/procs.c
index 854ddba22..e36e7ca16 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008, 2009 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
@@ -37,40 +37,26 @@
 /* {Procedures}
  */
 
-scm_t_subr_entry *scm_subr_table;
 
 /* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */
 
 /* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
    startup, 786 with guile-readline.  'martin */
 
-static unsigned long scm_subr_table_size = 0;
-static unsigned long scm_subr_table_room = 800;
-
-SCM 
+SCM
 scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
 {
   register SCM z;
-  unsigned long entry;
+  SCM *meta_info;
 
-  if (scm_subr_table_size == scm_subr_table_room)
-    {
-      long new_size = scm_subr_table_room * 3 / 2;
-      void *new_table
-	= scm_realloc ((char *) scm_subr_table,
-		       sizeof (scm_t_subr_entry) * new_size);
-      scm_subr_table = new_table;
-      scm_subr_table_room = new_size;
-    }
+  meta_info = scm_gc_malloc (2 * sizeof (* meta_info),
+			     "subr meta-info");
+  meta_info[0] = scm_from_locale_symbol (name);
+  meta_info[1] = SCM_EOL;  /* properties */
+
+  z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn,
+		       0 /* generic */, (scm_t_bits) meta_info);
 
-  entry = scm_subr_table_size;
-  z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
-  scm_subr_table[entry].handle = z;
-  scm_subr_table[entry].name = scm_from_locale_symbol (name);
-  scm_subr_table[entry].generic = 0;
-  scm_subr_table[entry].properties = SCM_EOL;
-  scm_subr_table_size++;
-  
   return z;
 }
 
@@ -87,11 +73,8 @@ scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
 void
 scm_free_subr_entry (SCM subr)
 {
-  long entry = SCM_SUBRNUM (subr);
-  /* Move last entry in table to the free position */
-  scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1];
-  SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry);
-  scm_subr_table_size--;
+  scm_gc_free (SCM_SUBR_META_INFO (subr), 2 * sizeof (SCM),
+	       "subr meta-info");
 }
 
 SCM
@@ -112,20 +95,6 @@ scm_c_define_subr_with_generic (const char *name,
   return subr;
 }
 
-void
-scm_mark_subr_table ()
-{
-  long i;
-  for (i = 0; i < scm_subr_table_size; ++i)
-    {
-      scm_gc_mark (scm_subr_table[i].name);
-      if (scm_subr_table[i].generic && *scm_subr_table[i].generic)
-	scm_gc_mark (*scm_subr_table[i].generic);
-      if (SCM_NIMP (scm_subr_table[i].properties))
-	scm_gc_mark (scm_subr_table[i].properties);
-    }
-}
-
 
 #ifdef CCLO
 SCM 
@@ -348,15 +317,7 @@ scm_setter (SCM proc)
   return SCM_BOOL_F; /* not reached */
 }
 
-
-void
-scm_init_subr_table ()
-{
-  scm_subr_table
-    = ((scm_t_subr_entry *)
-       scm_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room));
-}
-
+
 void
 scm_init_procs ()
 {
diff --git a/libguile/procs.h b/libguile/procs.h
index 6f8d4c21a..f0c0ee363 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -30,28 +30,15 @@
 /* Subrs 
  */
 
-typedef struct
-{
-  SCM handle;			/* link back to procedure object */
-  SCM name;
-  SCM *generic;			/* 0 if no generic support
-				 * *generic == 0 until first method
-				 */
-  SCM properties;		/* procedure properties */
-} scm_t_subr_entry;
-
-#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8)
-#define SCM_SET_SUBRNUM(subr, num) \
-        SCM_SET_CELL_WORD_0 (subr, (num << 8) + SCM_TYP7 (subr))
-#define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)])
-#define SCM_SNAME(x) (SCM_SUBR_ENTRY (x).name)
+#define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
+#define SCM_SNAME(x) (SCM_SUBR_META_INFO (x) [0])
 #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
 #define SCM_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
 #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x))
-#define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties)
-#define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic)
-#define SCM_SET_SUBR_GENERIC(x, g) (*SCM_SUBR_ENTRY (x).generic = (g))
-#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SUBR_ENTRY (x).generic = (g))
+#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
+#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
+#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
+#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g))
 
 #define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8)
 #define SCM_MAKE_CCLO_TAG(v)  (((v) << 8) + scm_tc7_cclo)
@@ -132,11 +119,9 @@ typedef struct
 #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
 #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
 
-SCM_API scm_t_subr_entry *scm_subr_table;
 
 
 
-SCM_API void scm_mark_subr_table (void);
 SCM_API void scm_free_subr_entry (SCM subr);
 SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
 SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
@@ -154,7 +139,6 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj);
 SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter);
 SCM_API SCM scm_procedure (SCM proc);
 SCM_API SCM scm_setter (SCM proc);
-SCM_INTERNAL void scm_init_subr_table (void);
 SCM_INTERNAL void scm_init_procs (void);
 
 #ifdef GUILE_DEBUG