* The creation of symbols and bindings are two separate issues now.

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

diff --git a/libguile/gc.c b/libguile/gc.c
index 0a6e968..eaf8ec7 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:
@@ -1654,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;
@@ -2445,18 +2435,31 @@ init_freelist (scm_freelist_t *freelist,
   freelist->heap_size = 0;
 }
 
+
+/* Get an integer from an environment variable.  */
+static int
+scm_i_getenv_int (const char *var, int def)
+{
+  char *end, *val = getenv (var);
+  long res;
+  if (!val)
+    return def;
+  res = strtol (val, &end, 10);
+  if (end == val)
+    return def;
+  return res;
+}
+
+
 int
-scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1,
-                 scm_sizet init_heap_size_2, int gc_trigger_2,
-                 scm_sizet max_segment_size)
+scm_init_storage ()
 {
+  scm_sizet gc_trigger_1;
+  scm_sizet gc_trigger_2;
+  scm_sizet init_heap_size_1;
+  scm_sizet init_heap_size_2;
   scm_sizet j;
 
-  if (!init_heap_size_1)
-    init_heap_size_1 = scm_default_init_heap_size_1;
-  if (!init_heap_size_2)
-    init_heap_size_2 = scm_default_init_heap_size_2;
-
   j = SCM_NUM_PROTECTS;
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
@@ -2464,14 +2467,11 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1,
 
   scm_freelist = SCM_EOL;
   scm_freelist2 = SCM_EOL;
-  init_freelist (&scm_master_freelist,
-                1, SCM_CLUSTER_SIZE_1,
-                gc_trigger_1 ? gc_trigger_1 : scm_default_min_yield_1);
-  init_freelist (&scm_master_freelist2,
-                2, SCM_CLUSTER_SIZE_2,
-                gc_trigger_2 ? gc_trigger_2 : scm_default_min_yield_2);
-  scm_max_segment_size
-    = max_segment_size ? max_segment_size : scm_default_max_segment_size;
+  gc_trigger_1 = scm_i_getenv_int ("GUILE_MIN_YIELD_1", scm_default_min_yield_1);
+  init_freelist (&scm_master_freelist, 1, SCM_CLUSTER_SIZE_1, gc_trigger_1);
+  gc_trigger_2 = scm_i_getenv_int ("GUILE_MIN_YIELD_2", scm_default_min_yield_2);
+  init_freelist (&scm_master_freelist2, 2, SCM_CLUSTER_SIZE_2, gc_trigger_2);
+  scm_max_segment_size = scm_i_getenv_int ("GUILE_MAX_SEGMENT_SIZE", scm_default_max_segment_size);
 
   scm_expmem = 0;
 
@@ -2483,6 +2483,8 @@ scm_init_storage (scm_sizet init_heap_size_1, int gc_trigger_1,
 
   mark_space_ptr = &mark_space_head;
 
+  init_heap_size_1 = scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", scm_default_init_heap_size_1);
+  init_heap_size_2 = scm_i_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", scm_default_init_heap_size_2);
   if (make_initial_segment (init_heap_size_1, &scm_master_freelist) ||
       make_initial_segment (init_heap_size_2, &scm_master_freelist2))
     return 1;
@@ -2516,9 +2518,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_symbols = 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);
@@ -2590,9 +2595,8 @@ 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);