allow GC of custodians that have a memory limit but no children

svn: r12850

src/mzscheme/src/salloc.c

@@ -1509,6 +1509,7 @@ static void print_tagged_value(const char *prefix,
 			       void *v, int xtagged, unsigned long diff, int max_w,
 			       const char *suffix)
 {
+  char buffer[256];
   char *type, *sep, diffstr[30];
   long len;
   
@@ -1520,7 +1521,6 @@ static void print_tagged_value(const char *prefix,
     type = scheme_write_to_string_w_max((Scheme_Object *)v, &len, max_w);
     if (!scheme_strncmp(type, "#<thread", 8) 
 	&& ((type[8] == '>') || (type[8] == ':'))) {
-      char buffer[256];
       char *run, *sus, *kill, *clean, *deq, *all, *t2;
       int state = ((Scheme_Thread *)v)->running, len2;
 	    
@@ -1541,7 +1541,6 @@ static void print_tagged_value(const char *prefix,
       len += len2;
       type = t2;
     } else if (!scheme_strncmp(type, "#<continuation>", 15)) {
-      char buffer[256];
       char *t2;
       int len2;
 	    
@@ -1561,8 +1560,20 @@ static void print_tagged_value(const char *prefix,
       memcpy(t2 + len, buffer, len2 + 1);
       len += len2;
       type = t2;
+    } else if (!scheme_strncmp(type, "#<custodian>", 13)) {
+      char *t2;
+      int len2;
+
+      sprintf(buffer, "[%d]",
+              ((Scheme_Custodian *)v)->elems);
+
+      len2 = strlen(buffer);
+      t2 = (char *)scheme_malloc_atomic(len + len2 + 1);
+      memcpy(t2, type, len);
+      memcpy(t2 + len, buffer, len2 + 1);
+      len += len2;
+      type = t2;      
     } else if (!scheme_strncmp(type, "#<namespace", 11)) {
-      char buffer[256];
       char *t2;
       int len2;
 	    
@@ -1596,7 +1607,6 @@ static void print_tagged_value(const char *prefix,
       type = t2;
     } else if (!scheme_strncmp(type, "#<hash-table>", 13)
 	       || !scheme_strncmp(type, "#<hash-table:", 13)) {
-      char buffer[256];
       char *t2;
       int len2;
       int htype, size, count;

src/mzscheme/src/schpriv.h

@@ -424,8 +424,8 @@ extern int scheme_overflow_count;
 
 struct Scheme_Custodian {
   Scheme_Object so;
-  char shut_down, has_limit;
-  int count, alloc;
+  char shut_down, has_limit, recorded;
+  int count, alloc, elems;
   Scheme_Object ***boxes;
   Scheme_Custodian_Reference **mrefs;
   Scheme_Close_Custodian_Client **closers;

src/mzscheme/src/thread.c

@@ -900,6 +900,28 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
 /*                              custodians                                */
 /*========================================================================*/
 
+static void adjust_limit_table(Scheme_Custodian *c)
+{
+  /* If a custodian has a limit and any object or children, then it
+     must not be collected and merged with its parent. To prevent
+     collection, we register the custodian in the `limite_custodians'
+     table. */
+  if (c->has_limit) {
+    if (c->elems || CUSTODIAN_FAM(c->children)) {
+      if (!c->recorded) {
+        c->recorded = 1;
+        if (!limited_custodians)
+          limited_custodians = scheme_make_hash_table(SCHEME_hash_ptr);
+        scheme_hash_set(limited_custodians, (Scheme_Object *)c, scheme_true);
+      }
+    } else if (c->recorded) {
+      c->recorded = 0;
+      if (limited_custodians)
+        scheme_hash_set(limited_custodians, (Scheme_Object *)c, NULL);
+    }
+  }
+}
+
 static Scheme_Object *custodian_require_mem(int argc, Scheme_Object *args[])
 {
   long lim;
@@ -975,13 +997,11 @@ static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[])
     }
   }
 
-  if (!limited_custodians)
-    limited_custodians = scheme_make_hash_table(SCHEME_hash_ptr);
-  scheme_hash_set(limited_custodians, args[0], scheme_true);
   ((Scheme_Custodian *)args[0])->has_limit = 1;
+  adjust_limit_table((Scheme_Custodian *)args[0]);
   if (argc > 2) {
-    scheme_hash_set(limited_custodians, args[2], scheme_true);
     ((Scheme_Custodian *)args[2])->has_limit = 1;
+    adjust_limit_table((Scheme_Custodian *)args[2]);
   }
 
 #ifdef NEWGC_BTC_ACCOUNT
@@ -1075,6 +1095,9 @@ static void add_managed_box(Scheme_Custodian *m,
       m->data[i] = data;
       m->mrefs[i] = mref;
 
+      m->elems++;
+      adjust_limit_table(m);
+
       return;
     }
   }
@@ -1086,6 +1109,9 @@ static void add_managed_box(Scheme_Custodian *m,
   m->data[m->count] = data;
   m->mrefs[m->count] = mref;
 
+  m->elems++;
+  adjust_limit_table(m);
+
   m->count++;
 }
 
@@ -1112,6 +1138,8 @@ static void remove_managed(Scheme_Custodian_Reference *mr, Scheme_Object *o,
       if (old_data)
 	*old_data = m->data[i];
       m->data[i] = NULL;
+      --m->elems;
+      adjust_limit_table(m);
       break;
     }
   }
@@ -1164,6 +1192,8 @@ static void adjust_custodian_family(void *mgr, void *skip_move)
       m = next;
     }
 
+    adjust_limit_table(parent);
+
     /* Add remaining managed items to parent: */
     if (!skip_move) {
       for (i = 0; i < r->count; i++) {
@@ -1221,6 +1251,9 @@ void insert_custodian(Scheme_Custodian *m, Scheme_Custodian *parent)
     CUSTODIAN_FAM(m->global_next) = NULL;
     CUSTODIAN_FAM(m->global_prev) = NULL;
   }
+
+  if (parent)
+    adjust_limit_table(parent);
 }
 
 Scheme_Custodian *scheme_make_custodian(Scheme_Custodian *parent) 
@@ -1483,6 +1516,7 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F
 
     m->count = 0;
     m->alloc = 0;
+    m->elems = 0;
     m->boxes = NULL;
     m->closers = NULL;
     m->data = NULL;
@@ -1496,9 +1530,7 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F
     /* Remove this custodian from its parent */
     adjust_custodian_family(m, m);
 
-    if (m->has_limit) {
-      scheme_hash_set(limited_custodians, (Scheme_Object *)m, NULL);
-    }
+    adjust_limit_table(m);
     
     m = next_m;
   }