* 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 8ce64db..e04d50b 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1025,14 +1025,7 @@ scm_igc (const char *what)
 
 #ifndef USE_THREADS
 
-  /* Protect from the C stack.  This must be the first marking
-   * done because it provides information about what objects
-   * are "in-use" by the C code.   "in-use" objects are  those
-   * for which the information about length and base address must
-   * remain usable.   This requirement is stricter than a liveness
-   * requirement -- in particular, it constrains the implementation
-   * of scm_vector_set_length_x.
-   */
+  /* Mark objects on the C stack. */
   SCM_FLUSH_REGISTER_WINDOWS;
   /* This assumes that all registers are saved into the jmp_buf */
   setjmp (scm_save_regs_gc_mark);
@@ -1057,10 +1050,6 @@ scm_igc (const char *what)
 
 #endif /* USE_THREADS */
 
-  /* FIXME: insert a phase to un-protect string-data preserved
-   * in scm_vector_set_length_x.
-   */
-
   j = SCM_NUM_PROTECTS;
   while (j--)
     scm_gc_mark (scm_sys_protects[j]);
@@ -1223,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:
@@ -1330,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);
@@ -1615,9 +1599,15 @@ scm_gc_sweep ()
               scm_must_free (SCM_VECTOR_BASE (scmptr) - 2);
               break;
            case scm_tc7_vector:
-             m += (SCM_VECTOR_LENGTH (scmptr) * sizeof (SCM));
-             scm_must_free (SCM_VECTOR_BASE (scmptr));
-             break;
+             {
+               unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
+               if (length > 0)
+                 {
+                   m += length * sizeof (scm_bits_t);
+                   scm_must_free (SCM_VECTOR_BASE (scmptr));
+                 }
+               break;
+             }
 #ifdef CCLO
            case scm_tc7_cclo:
              m += (SCM_CCLO_LENGTH (scmptr) * sizeof (SCM));
@@ -1626,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:
@@ -1639,7 +1635,7 @@ scm_gc_sweep ()
            case scm_tc7_fvect:
            case scm_tc7_dvect:
            case scm_tc7_cvect:
-             m += SCM_HUGE_LENGTH (scmptr) * scm_uniform_element_size (scmptr);
+             m += SCM_UVECTOR_LENGTH (scmptr) * scm_uniform_element_size (scmptr);
              scm_must_free (SCM_UVECTOR_BASE (scmptr));
              break;
 #endif
@@ -1653,18 +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);
-             if (SCM_CONTREGS (scmptr))
-               {
-                 scm_must_free (SCM_CONTREGS (scmptr));
-                 break;
-               }
-             else
-               {
-                 continue;
-               }
            case scm_tcs_subrs:
               /* the various "subrs" (primitives) are never freed */
              continue;
@@ -2284,7 +2268,9 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
 
 void
 scm_remember (SCM *ptr)
-{ /* empty */ }
+{
+  /* empty */ 
+}
 
 
 /*
@@ -2520,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);
@@ -2594,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
 }
 
 /*