* Guile does not assume a hash table size of scm_symhash_dim any more.

[bpt/guile.git] / libguile / gc.c

diff --git a/libguile/gc.c b/libguile/gc.c
index fa64742..e04d50b 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1212,24 +1212,19 @@ gc_mark_nimp:
       goto gc_mark_loop;
 #ifdef CCLO
     case scm_tc7_cclo:
-      i = SCM_CCLO_LENGTH (ptr);
-      if (i == 0)
-       break;
-      while (--i > 0)
-       if (SCM_NIMP (SCM_VELTS (ptr)[i]))
-         scm_gc_mark (SCM_VELTS (ptr)[i]);
-      ptr = SCM_VELTS (ptr)[0];
-      goto gc_mark_loop;
+      {
+       unsigned long int i = SCM_CCLO_LENGTH (ptr);
+       unsigned long int j;
+       for (j = 1; j != i; ++j)
+         {
+           SCM obj = SCM_CCLO_REF (ptr, j);
+           if (!SCM_IMP (obj))
+             scm_gc_mark (obj);
+         }
+       ptr = SCM_CCLO_REF (ptr, 0);
+       goto gc_mark_loop;
+      }
 #endif
-    case scm_tc7_contin:
-      if (SCM_VELTS (ptr))
-       scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr),
-                           (scm_sizet)
-                           (SCM_CONTINUATION_LENGTH (ptr) +
-                            (sizeof (SCM_STACKITEM) + -1 +
-                             sizeof (scm_contregs)) /
-                            sizeof (SCM_STACKITEM)));
-      break;
 #ifdef HAVE_ARRAYS
     case scm_tc7_bvect:
     case scm_tc7_byvect:
@@ -1319,7 +1314,7 @@ gc_mark_nimp:
       if (!(i < scm_numptob))
        goto def;
       if (SCM_PTAB_ENTRY(ptr))
-       scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name);
+       scm_gc_mark (SCM_FILENAME (ptr));
       if (scm_ptobs[i].mark)
        {
          ptr = (scm_ptobs[i].mark) (ptr);
@@ -1621,8 +1616,14 @@ scm_gc_sweep ()
 #endif
 #ifdef HAVE_ARRAYS
            case scm_tc7_bvect:
-             m += sizeof (long) * ((SCM_BITVECTOR_LENGTH (scmptr) + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
-             scm_must_free (SCM_BITVECTOR_BASE (scmptr));
+             {
+               unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
+               if (length > 0)
+                 {
+                   m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+                   scm_must_free (SCM_BITVECTOR_BASE (scmptr));
+                 }
+             }
              break;
            case scm_tc7_byvect:
            case scm_tc7_ivect:
@@ -1648,11 +1649,6 @@ scm_gc_sweep ()
              m += SCM_SYMBOL_LENGTH (scmptr) + 1;
              scm_must_free (SCM_SYMBOL_CHARS (scmptr));
              break;
-           case scm_tc7_contin:
-             m += SCM_CONTINUATION_LENGTH (scmptr) * sizeof (SCM_STACKITEM)
-                  + sizeof (scm_contregs);
-             scm_must_free (SCM_CONTREGS (scmptr));
-             break;
            case scm_tcs_subrs:
               /* the various "subrs" (primitives) are never freed */
              continue;
@@ -2272,7 +2268,9 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
 
 void
 scm_remember (SCM *ptr)
-{ /* empty */ }
+{
+  /* empty */ 
+}
 
 
 /*
@@ -2508,9 +2506,12 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1,
   scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
   scm_nullstr = scm_makstr (0L, 0);
   scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
-  scm_symhash = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
-  scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM (scm_symhash_dim));
-  scm_symhash_vars = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
+
+#define DEFAULT_SYMHASH_SIZE 277
+  scm_symhash = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
+  scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE));
+  scm_symhash_vars = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
+
   scm_stand_in_procs = SCM_EOL;
   scm_permobjs = SCM_EOL;
   scm_protects = scm_make_vector (SCM_MAKINUM (31), SCM_EOL);
@@ -2582,13 +2583,14 @@ scm_init_gc ()
 #if (SCM_DEBUG_DEPRECATED == 0)
   scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F);
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
-  /* Dirk:FIXME:: We don't really want a binding here. */
-  after_gc_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, gc_async_thunk);
-  gc_async = scm_system_async (after_gc_thunk);
+  after_gc_thunk = scm_make_subr_opt ("%gc-thunk", scm_tc7_subr_0, gc_async_thunk, 0);
+  gc_async = scm_system_async (after_gc_thunk);  /* protected via scm_asyncs */
 
   scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
 
+#ifndef SCM_MAGIC_SNARFER
 #include "libguile/gc.x"
+#endif
 }
 
 /*