diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c index 26d137189f..7117ccc58d 100644 --- a/src/mzscheme/src/salloc.c +++ b/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, "#') || (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, "#", 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, "#", 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, "#", 13) || !scheme_strncmp(type, "#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; }