* gc.h, gc.c (scm_i_gc_admin_mutex): New, to protect

scm_gc_mallocated, for now.
(scm_init_storage): Initialize it.
* gc-malloc.c (descrease_mtrigger, increase_mtrigger): Use it.

* gc-mark.c (scm_gc_mark_dependencies): Call scm_i_string_mark,
scm_i_stringbuf_mark and scm_i_symbol_mark, as appropriate.
* gc-card.c (scm_i_sweep_card):  Call scm_i_string_free,
scm_i_stringbuf_free and scm_i_symbol_free, as appropriate.

diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 2f57736..3bbd123 100644 (file)
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004 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
@@ -193,12 +193,13 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
             }
           break;
        case scm_tc7_string:
-         scm_gc_free (SCM_I_STRING_CHARS (scmptr), 
-                      SCM_I_STRING_LENGTH (scmptr) + 1, "string");
+         scm_i_string_free (scmptr);
+         break;
+       case scm_tc7_stringbuf:
+         scm_i_stringbuf_free (scmptr);
          break;
        case scm_tc7_symbol:
-         scm_gc_free (SCM_SYMBOL_CHARS (scmptr), 
-                      SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol");
+         scm_i_symbol_free (scmptr); 
          break;
        case scm_tc7_variable:
          break;

diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index ef7a4e4..b909e94 100644 (file)
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -177,23 +177,37 @@ scm_strdup (const char *str)
   return scm_strndup (str, strlen (str));
 }
 
-
 static void
 decrease_mtrigger (size_t size, const char * what)
 {
+  scm_i_plugin_mutex_lock (&scm_i_gc_admin_mutex);
   scm_mallocated -= size;
   scm_gc_malloc_collected += size;
+  scm_i_plugin_mutex_unlock (&scm_i_gc_admin_mutex);
 }
 
 static void
 increase_mtrigger (size_t size, const char *what)
 {
+  size_t mallocated = 0;
+  int overflow = 0, triggered = 0;
+
+  scm_i_plugin_mutex_lock (&scm_i_gc_admin_mutex);
   if (ULONG_MAX - size < scm_mallocated)
+    overflow = 1;
+  else
     {
-      scm_memory_error ("Overflow of scm_mallocated: too much memory in use.");
+      scm_mallocated += size;
+      mallocated = scm_mallocated;
+      if (scm_mallocated > scm_mtrigger)
+       triggered = 1;
     }
+  scm_i_plugin_mutex_unlock (&scm_i_gc_admin_mutex);
 
-  scm_mallocated += size;
+  if (overflow)
+    {
+      scm_memory_error ("Overflow of scm_mallocated: too much memory in use.");
+    }
 
   /*
     A program that uses a lot of malloced collectable memory (vectors,
@@ -201,14 +215,14 @@ increase_mtrigger (size_t size, const char *what)
     do GC more often (before cells are exhausted), otherwise swapping
     and malloc management will tie it down.
    */
-  if (scm_mallocated > scm_mtrigger)
+  if (triggered)
     {
       unsigned long prev_alloced;
       float yield;
       
       scm_rec_mutex_lock (&scm_i_sweep_mutex);
       
-      prev_alloced  = scm_mallocated;
+      prev_alloced  = mallocated;
       scm_igc (what);
       scm_i_sweep_all_segments ("mtrigger");
 

diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index cb966c9..8c5991f 100644 (file)
--- 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 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 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
@@ -199,9 +199,9 @@ scm_gc_mark_dependencies (SCM p)
        scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct;
        scm_t_bits * vtable_data = (scm_t_bits *) word0;
        SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
-       long len = SCM_SYMBOL_LENGTH (layout);
-       char * fields_desc = SCM_SYMBOL_CHARS (layout);
-       scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
+       long len = scm_i_symbol_length (layout);
+       const char *fields_desc = scm_i_symbol_chars (layout);
+       scm_t_bits *struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
 
        if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
          {
@@ -276,9 +276,15 @@ scm_gc_mark_dependencies (SCM p)
 #if SCM_SIZEOF_LONG_LONG != 0
     case scm_tc7_llvect:
 #endif
+      break;
 #endif
+
     case scm_tc7_string:
-      break;
+      ptr = scm_i_string_mark (ptr);
+      goto gc_mark_loop;
+    case scm_tc7_stringbuf:
+      ptr = scm_i_stringbuf_mark (ptr);
+      goto gc_mark_loop;
 
     case scm_tc7_number:
       if (SCM_TYP16 (ptr) == scm_tc16_fraction)
@@ -349,7 +355,7 @@ scm_gc_mark_dependencies (SCM p)
       break;
 
     case scm_tc7_symbol:
-      ptr = SCM_PROP_SLOTS (ptr);
+      ptr = scm_i_symbol_mark (ptr);
       goto gc_mark_loop;
     case scm_tc7_variable:
       ptr = SCM_CELL_OBJECT_1 (ptr);

diff --git a/libguile/gc.c b/libguile/gc.c
index 2e163df..5b3dfa4 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -642,7 +642,7 @@ scm_igc (const char *what)
  * the conservative gc we add the call to scm_remember_upto_here_1 _after_ the
  * call to 'some_function'.  Note that this would not be necessary if str was
  * used anyway after the call to 'some_function'.
- *   char *chars = SCM_I_STRING_CHARS (str);
+ *   char *chars = scm_i_string_chars (str);
  *   some_function (chars);
  *   scm_remember_upto_here_1 (str);  // str will be alive up to this point.
  */
@@ -884,6 +884,8 @@ scm_storage_prehistory ()
   scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
 }
 
+scm_t_mutex scm_i_gc_admin_mutex;
+
 int
 scm_init_storage ()
 {
@@ -891,6 +893,8 @@ scm_init_storage ()
 
   /* Fixme: Should use mutexattr from the low-level API. */
   scm_rec_mutex_init (&scm_i_sweep_mutex, &scm_i_plugin_rec_mutex);
+
+  scm_i_plugin_mutex_init (&scm_i_gc_admin_mutex, &scm_i_plugin_mutex);
   
   j = SCM_NUM_PROTECTS;
   while (j)

diff --git a/libguile/gc.h b/libguile/gc.h
index 0dc40f6..4e54644 100644 (file)
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -230,6 +230,8 @@ SCM_API int scm_debug_cells_gc_interval ;
 void scm_i_expensive_validation_check (SCM cell);
 #endif
 
+SCM_API scm_t_mutex scm_i_gc_admin_mutex;
+
 SCM_API int scm_block_gc;
 SCM_API int scm_gc_heap_lock;
 SCM_API unsigned int scm_gc_running_p;