From 22706f29b62194669b59d53cc95d2b9103dccdf2 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Wed, 5 Nov 2008 21:03:56 +0000 Subject: [PATCH] Separate out blame the child svn: r12246 --- src/mzscheme/gc2/newgc.c | 535 +----------------- .../gc2/newgc_parts/blame_the_child.c | 531 +++++++++++++++++ 2 files changed, 532 insertions(+), 534 deletions(-) create mode 100644 src/mzscheme/gc2/newgc_parts/blame_the_child.c diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index bde68879ac..f968100351 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -1522,540 +1522,7 @@ inline static void reset_pointer_stack(void) int_top->top = PPTR(int_top) + 4; } -/*****************************************************************************/ -/* blame-the-child accounting */ -/*****************************************************************************/ -#ifdef NEWGC_BTC_ACCOUNT - -#define OWNER_TABLE_INIT_AMT 10 - -struct ot_entry { - Scheme_Custodian *originator; - Scheme_Custodian **members; - unsigned long memory_use; - unsigned long single_time_limit, super_required; - char limit_set, required_set; -}; - -static struct ot_entry **owner_table = NULL; -static unsigned int owner_table_top = 0; -static int doing_memory_accounting = 0; -static int really_doing_accounting = 0; -static int current_mark_owner = 0; -static int old_btc_mark = 0; -static int new_btc_mark = 1; -static int reset_limits = 0, reset_required = 0; - -inline static int create_blank_owner_set(void) -{ - int i; - unsigned int old_top; - struct ot_entry **naya; - - for (i = 1; i < owner_table_top; i++) { - if (!owner_table[i]) { - owner_table[i] = malloc(sizeof(struct ot_entry)); - if (!owner_table[i]) out_of_memory(); - bzero(owner_table[i], sizeof(struct ot_entry)); - return i; - } - } - - old_top = owner_table_top; - if (!owner_table_top) - owner_table_top = OWNER_TABLE_INIT_AMT; - else - owner_table_top *= 2; - - naya = (struct ot_entry **)malloc(owner_table_top*sizeof(struct ot_entry*)); - if (!naya) out_of_memory(); - memcpy(naya, owner_table, old_top*sizeof(struct ot_entry*)); - owner_table = naya; - bzero((char*)owner_table + (sizeof(struct ot_entry*) * old_top), - (owner_table_top - old_top) * sizeof(struct ot_entry*)); - - return create_blank_owner_set(); -} - -inline static int custodian_to_owner_set(Scheme_Custodian *cust) -{ - int i; - - if (cust->gc_owner_set) - return cust->gc_owner_set; - - i = create_blank_owner_set(); - owner_table[i]->originator = cust; - cust->gc_owner_set = i; - - return i; -} - -inline static int current_owner(Scheme_Custodian *c) -{ - if (!scheme_current_thread) - return 1; - else if (!c) - return thread_get_owner(scheme_current_thread); - else - return custodian_to_owner_set(c); -} - -void GC_register_root_custodian(void *_c) -{ - Scheme_Custodian *c = (Scheme_Custodian *)_c; - - if (owner_table) { - /* Reset */ - free(owner_table); - owner_table = NULL; - owner_table_top = 0; - } - - if (create_blank_owner_set() != 1) { - GCPRINT(GCOUTF, "Something extremely weird (and bad) has happened.\n"); - abort(); - } - - owner_table[1]->originator = c; - c->gc_owner_set = 1; -} - -inline static int custodian_member_owner_set(void *cust, int set) -{ - Scheme_Custodian_Reference *box; - Scheme_Custodian *work = owner_table[set]->originator; - - while(work) { - if(work == cust) return 1; - box = work->parent; - work = box ? SCHEME_PTR1_VAL(box) : NULL; - } - return 0; -} - -inline static void account_memory(int set, long amount) -{ - owner_table[set]->memory_use += amount; -} - -inline static void free_owner_set(int set) -{ - if(owner_table[set]) { - free(owner_table[set]); - } - owner_table[set] = NULL; -} - -inline static void clean_up_owner_table(void) -{ - int i; - - for(i = 1; i < owner_table_top; i++) - if(owner_table[i]) { - /* repair or delete the originator */ - if(!marked(owner_table[i]->originator)) { - owner_table[i]->originator = NULL; - } else - owner_table[i]->originator = GC_resolve(owner_table[i]->originator); - - /* potential delete */ - if(i != 1) - if((owner_table[i]->memory_use == 0) && !owner_table[i]->originator) - free_owner_set(i); - } -} - -inline static unsigned long custodian_usage(void *custodian) -{ - unsigned long retval = 0; - int i; - - if(!really_doing_accounting) { - park[0] = custodian; - really_doing_accounting = 1; - garbage_collect(1); - custodian = park[0]; - park[0] = NULL; - } - for(i = 1; i < owner_table_top; i++) - if(owner_table[i] && custodian_member_owner_set(custodian, i)) - retval += owner_table[i]->memory_use; - return gcWORDS_TO_BYTES(retval); -} - -inline static void memory_account_mark(struct mpage *page, void *ptr) -{ - GCDEBUG((DEBUGOUTF, "memory_account_mark: %p/%p\n", page, ptr)); - if(page->big_page) { - struct objhead *info = (struct objhead *)(NUM(page->addr) + PREFIX_SIZE); - - if(info->btc_mark == old_btc_mark) { - info->btc_mark = new_btc_mark; - account_memory(current_mark_owner, gcBYTES_TO_WORDS(page->size)); - push_ptr(ptr); - } - } else { - struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); - - if(info->btc_mark == old_btc_mark) { - info->btc_mark = new_btc_mark; - account_memory(current_mark_owner, info->size); - push_ptr(ptr); - } - } -} - -int BTC_thread_mark(void *p) -{ - return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; -} - -int BTC_custodian_mark(void *p) -{ - if(custodian_to_owner_set(p) == current_mark_owner) - return normal_custodian_mark(p); - else - return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; -} - -int BTC_cust_box_mark(void *p) -{ - return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; -} - -inline static void mark_normal_obj(struct mpage *page, void *ptr) -{ - switch(page->page_type) { - case PAGE_TAGGED: { - /* we do not want to mark the pointers in a thread or custodian - unless the object's owner is the current owner. In the case - of threads, we already used it for roots, so we can just - ignore them outright. In the case of custodians, we do need - to do the check; those differences are handled by replacing - the mark procedure in mark_table. */ - mark_table[*(unsigned short*)ptr](ptr); - break; - } - case PAGE_ATOMIC: break; - case PAGE_ARRAY: { - struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); - void **temp = ptr, **end = temp + (info->size - 1); - - while(temp < end) gcMARK(*(temp++)); - break; - }; - case PAGE_TARRAY: { - struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); - unsigned short tag = *(unsigned short*)ptr; - void **temp = ptr, **end = PPTR(info) + (info->size - INSET_WORDS); - - while(temp < end) temp += mark_table[tag](temp); - break; - } - case PAGE_XTAGGED: GC_mark_xtagged(ptr); break; - } -} - -inline static void mark_acc_big_page(struct mpage *page) -{ - void **start = PPTR(NUM(page->addr) + PREFIX_SIZE + WORD_SIZE); - void **end = PPTR(NUM(page->addr) + page->size); - - switch(page->page_type) { - case PAGE_TAGGED: - { - unsigned short tag = *(unsigned short*)start; - if((unsigned long)mark_table[tag] < PAGE_TYPES) { - /* atomic */ - } else - mark_table[tag](start); break; - } - case PAGE_ATOMIC: break; - case PAGE_ARRAY: while(start < end) gcMARK(*(start++)); break; - case PAGE_XTAGGED: GC_mark_xtagged(start); break; - case PAGE_TARRAY: { - unsigned short tag = *(unsigned short *)start; - end -= INSET_WORDS; - while(start < end) start += mark_table[tag](start); - break; - } - } -} - -int kill_propagation_loop = 0; - -static void btc_overmem_abort() -{ - kill_propagation_loop = 1; - GCWARN((GCOUTF, "WARNING: Ran out of memory accounting. " - "Info will be wrong.\n")); -} - -static void propagate_accounting_marks(void) -{ - struct mpage *page; - void *p; - - while(pop_ptr(&p) && !kill_propagation_loop) { - page = find_page(p); - set_backtrace_source(p, page->page_type); - GCDEBUG((DEBUGOUTF, "btc_account: popped off page %p:%p, ptr %p\n", page, page->addr, p)); - if(page->big_page) - mark_acc_big_page(page); - else - mark_normal_obj(page, p); - } - if(kill_propagation_loop) - reset_pointer_stack(); -} - -static void do_btc_accounting(void) -{ - if(really_doing_accounting) { - Scheme_Custodian *cur = owner_table[current_owner(NULL)]->originator; - Scheme_Custodian_Reference *box = cur->global_next; - int i; - - GCDEBUG((DEBUGOUTF, "\nBEGINNING MEMORY ACCOUNTING\n")); - doing_memory_accounting = 1; - in_unsafe_allocation_mode = 1; - unsafe_allocation_abort = btc_overmem_abort; - - if(!normal_thread_mark) { - normal_thread_mark = mark_table[scheme_thread_type]; - normal_custodian_mark = mark_table[scheme_custodian_type]; - normal_cust_box_mark = mark_table[cust_box_tag]; - } - mark_table[scheme_thread_type] = &BTC_thread_mark; - mark_table[scheme_custodian_type] = &BTC_custodian_mark; - mark_table[ephemeron_tag] = btc_mark_ephemeron; - mark_table[cust_box_tag] = BTC_cust_box_mark; - - /* clear the memory use numbers out */ - for(i = 1; i < owner_table_top; i++) - if(owner_table[i]) - owner_table[i]->memory_use = 0; - - /* the end of the custodian list is where we want to start */ - while(SCHEME_PTR1_VAL(box)) { - cur = (Scheme_Custodian*)SCHEME_PTR1_VAL(box); - box = cur->global_next; - } - - /* walk backwards for the order we want */ - while(cur) { - int owner = custodian_to_owner_set(cur); - - current_mark_owner = owner; - GCDEBUG((DEBUGOUTF,"MARKING THREADS OF OWNER %i (CUST %p)\n", - owner, cur)); - kill_propagation_loop = 0; - mark_threads(owner); - mark_cust_boxes(cur); - GCDEBUG((DEBUGOUTF, "Propagating accounting marks\n")); - propagate_accounting_marks(); - - box = cur->global_prev; cur = box ? SCHEME_PTR1_VAL(box) : NULL; - } - - mark_table[scheme_thread_type] = normal_thread_mark; - mark_table[scheme_custodian_type] = normal_custodian_mark; - mark_table[ephemeron_tag] = mark_ephemeron; - mark_table[cust_box_tag] = normal_cust_box_mark; - in_unsafe_allocation_mode = 0; - doing_memory_accounting = 0; - old_btc_mark = new_btc_mark; - new_btc_mark = !new_btc_mark; - } - clear_stack_pages(); -} - -struct account_hook { - int type; - void *c1, *c2; - unsigned long amount; - struct account_hook *next; -}; - -static struct account_hook *hooks = NULL; - -inline static void add_account_hook(int type,void *c1,void *c2,unsigned long b) -{ - struct account_hook *work; - - if(!really_doing_accounting) { - park[0] = c1; park[1] = c2; - really_doing_accounting = 1; - garbage_collect(1); - c1 = park[0]; c2 = park[1]; - park[0] = park[1] = NULL; - } - - if (type == MZACCT_LIMIT) - reset_limits = 1; - if (type == MZACCT_REQUIRE) - reset_required = 1; - - for(work = hooks; work; work = work->next) { - if((work->type == type) && (work->c2 == c2) && (work->c1 == c1)) { - if(type == MZACCT_REQUIRE) { - if(b > work->amount) work->amount = b; - } else { /* (type == MZACCT_LIMIT) */ - if(b < work->amount) work->amount = b; - } - break; - } - } - - if(!work) { - work = malloc(sizeof(struct account_hook)); - if (!work) out_of_memory(); - work->type = type; work->c1 = c1; work->c2 = c2; work->amount = b; - work->next = hooks; hooks = work; - } -} - -inline static void clean_up_account_hooks() -{ - struct account_hook *work = hooks, *prev = NULL; - - while(work) { - if((!work->c1 || marked(work->c1)) && marked(work->c2)) { - work->c1 = GC_resolve(work->c1); - work->c2 = GC_resolve(work->c2); - prev = work; work = work->next; - } else { - struct account_hook *next = work->next; - - if(prev) prev->next = next; - if(!prev) hooks = next; - free(work); - work = next; - } - } -} - -static unsigned long custodian_super_require(void *c) -{ - int set = ((Scheme_Custodian *)c)->gc_owner_set; - - if (reset_required) { - int i; - for(i = 1; i < owner_table_top; i++) - if (owner_table[i]) - owner_table[i]->required_set = 0; - reset_required = 0; - } - - if (!owner_table[set]->required_set) { - unsigned long req = 0, r; - struct account_hook *work = hooks; - - while(work) { - if ((work->type == MZACCT_REQUIRE) && (c == work->c2)) { - r = work->amount + custodian_super_require(work->c1); - if (r > req) - req = r; - } - work = work->next; - } - owner_table[set]->super_required = req; - owner_table[set]->required_set = 1; - } - - return owner_table[set]->super_required; -} - -inline static void run_account_hooks() -{ - struct account_hook *work = hooks, *prev = NULL; - - while(work) { - if( ((work->type == MZACCT_REQUIRE) && - ((used_pages > (max_used_pages / 2)) - || ((((max_used_pages / 2) - used_pages) * APAGE_SIZE) - < (work->amount + custodian_super_require(work->c1))))) - || - ((work->type == MZACCT_LIMIT) && - (GC_get_memory_use(work->c1) > work->amount))) { - struct account_hook *next = work->next; - - if(prev) prev->next = next; - if(!prev) hooks = next; - scheme_schedule_custodian_close(work->c2); - free(work); - work = next; - } else { - prev = work; work = work->next; - } - } -} - -static unsigned long custodian_single_time_limit(int set) -{ - if (!set) - return (unsigned long)(long)-1; - - if (reset_limits) { - int i; - for(i = 1; i < owner_table_top; i++) - if (owner_table[i]) - owner_table[i]->limit_set = 0; - reset_limits = 0; - } - - if (!owner_table[set]->limit_set) { - /* Check for limits on this custodian or one of its ancestors: */ - unsigned long limit = (unsigned long)(long)-1; - Scheme_Custodian *orig = owner_table[set]->originator, *c; - struct account_hook *work = hooks; - - while(work) { - if ((work->type == MZACCT_LIMIT) && (work->c1 == work->c2)) { - c = orig; - while (1) { - if (work->c2 == c) { - if (work->amount < limit) - limit = work->amount; - break; - } - if (!c->parent) - break; - c = (Scheme_Custodian*)SCHEME_PTR1_VAL(c->parent); - if (!c) - break; - } - } - work = work->next; - } - owner_table[set]->single_time_limit = limit; - owner_table[set]->limit_set = 1; - } - - return owner_table[set]->single_time_limit; -} - - -# define set_account_hook(a,b,c,d) { add_account_hook(a,b,c,d); return 1; } -# define set_btc_mark(x) (((struct objhead *)(x))->btc_mark = old_btc_mark) -#endif - -#ifndef NEWGC_BTC_ACCOUNT -# define clean_up_owner_table() /* */ -# define do_btc_accounting() /* */ -# define doing_memory_accounting 0 -# define memory_account_mark(p,o) /* */ -# define set_account_hook(a,b,c,d) return 0 -# define clean_up_account_hooks() /* */ -# define run_account_hooks() /* */ -# define custodian_usage(cust) 0 -# define set_btc_mark(x) /* */ -static unsigned long custodian_single_time_limit(int set) -{ - return (unsigned long)(long)-1; -} -#endif +#include "newgc_parts/btc.c" int GC_set_account_hook(int type, void *c1, unsigned long b, void *c2) { diff --git a/src/mzscheme/gc2/newgc_parts/blame_the_child.c b/src/mzscheme/gc2/newgc_parts/blame_the_child.c new file mode 100644 index 0000000000..842c7122f9 --- /dev/null +++ b/src/mzscheme/gc2/newgc_parts/blame_the_child.c @@ -0,0 +1,531 @@ +/*****************************************************************************/ +/* blame-the-child accounting */ +/*****************************************************************************/ +#ifdef NEWGC_BTC_ACCOUNT + +#define OWNER_TABLE_INIT_AMT 10 + +struct ot_entry { + Scheme_Custodian *originator; + Scheme_Custodian **members; + unsigned long memory_use; + unsigned long single_time_limit, super_required; + char limit_set, required_set; +}; + +static struct ot_entry **owner_table = NULL; +static unsigned int owner_table_top = 0; +static int doing_memory_accounting = 0; +static int really_doing_accounting = 0; +static int current_mark_owner = 0; +static int old_btc_mark = 0; +static int new_btc_mark = 1; +static int reset_limits = 0, reset_required = 0; + +inline static int create_blank_owner_set(void) +{ + int i; + unsigned int old_top; + struct ot_entry **naya; + + for (i = 1; i < owner_table_top; i++) { + if (!owner_table[i]) { + owner_table[i] = malloc(sizeof(struct ot_entry)); + bzero(owner_table[i], sizeof(struct ot_entry)); + return i; + } + } + + old_top = owner_table_top; + if (!owner_table_top) + owner_table_top = OWNER_TABLE_INIT_AMT; + else + owner_table_top *= 2; + + naya = (struct ot_entry **)malloc(owner_table_top*sizeof(struct ot_entry*)); + memcpy(naya, owner_table, old_top*sizeof(struct ot_entry*)); + owner_table = naya; + bzero((char*)owner_table + (sizeof(struct ot_entry*) * old_top), + (owner_table_top - old_top) * sizeof(struct ot_entry*)); + + return create_blank_owner_set(); +} + +inline static int custodian_to_owner_set(Scheme_Custodian *cust) +{ + int i; + + if (cust->gc_owner_set) + return cust->gc_owner_set; + + i = create_blank_owner_set(); + owner_table[i]->originator = cust; + cust->gc_owner_set = i; + + return i; +} + +inline static int current_owner(Scheme_Custodian *c) +{ + if (!scheme_current_thread) + return 1; + else if (!c) + return thread_get_owner(scheme_current_thread); + else + return custodian_to_owner_set(c); +} + +void GC_register_root_custodian(void *_c) +{ + Scheme_Custodian *c = (Scheme_Custodian *)_c; + + if (owner_table) { + /* Reset */ + free(owner_table); + owner_table = NULL; + owner_table_top = 0; + } + + if (create_blank_owner_set() != 1) { + GCPRINT(GCOUTF, "Something extremely weird (and bad) has happened.\n"); + abort(); + } + + owner_table[1]->originator = c; + c->gc_owner_set = 1; +} + +inline static int custodian_member_owner_set(void *cust, int set) +{ + Scheme_Custodian_Reference *box; + Scheme_Custodian *work = owner_table[set]->originator; + + while(work) { + if(work == cust) return 1; + box = work->parent; + work = box ? SCHEME_PTR1_VAL(box) : NULL; + } + return 0; +} + +inline static void account_memory(int set, long amount) +{ + owner_table[set]->memory_use += amount; +} + +inline static void free_owner_set(int set) +{ + if(owner_table[set]) { + free(owner_table[set]); + } + owner_table[set] = NULL; +} + +inline static void clean_up_owner_table(void) +{ + int i; + + for(i = 1; i < owner_table_top; i++) + if(owner_table[i]) { + /* repair or delete the originator */ + if(!marked(owner_table[i]->originator)) { + owner_table[i]->originator = NULL; + } else + owner_table[i]->originator = GC_resolve(owner_table[i]->originator); + + /* potential delete */ + if(i != 1) + if((owner_table[i]->memory_use == 0) && !owner_table[i]->originator) + free_owner_set(i); + } +} + +inline static unsigned long custodian_usage(void *custodian) +{ + unsigned long retval = 0; + int i; + + if(!really_doing_accounting) { + park[0] = custodian; + really_doing_accounting = 1; + garbage_collect(1); + custodian = park[0]; + park[0] = NULL; + } + for(i = 1; i < owner_table_top; i++) + if(owner_table[i] && custodian_member_owner_set(custodian, i)) + retval += owner_table[i]->memory_use; + return gcWORDS_TO_BYTES(retval); +} + +inline static void memory_account_mark(struct mpage *page, void *ptr) +{ + GCDEBUG((DEBUGOUTF, "memory_account_mark: %p/%p\n", page, ptr)); + if(page->big_page) { + struct objhead *info = (struct objhead *)(NUM(page->addr) + PREFIX_SIZE); + + if(info->btc_mark == old_btc_mark) { + info->btc_mark = new_btc_mark; + account_memory(current_mark_owner, gcBYTES_TO_WORDS(page->size)); + push_ptr(ptr); + } + } else { + struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); + + if(info->btc_mark == old_btc_mark) { + info->btc_mark = new_btc_mark; + account_memory(current_mark_owner, info->size); + push_ptr(ptr); + } + } +} + +int BTC_thread_mark(void *p) +{ + return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; +} + +int BTC_custodian_mark(void *p) +{ + if(custodian_to_owner_set(p) == current_mark_owner) + return normal_custodian_mark(p); + else + return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; +} + +int BTC_cust_box_mark(void *p) +{ + return ((struct objhead *)(NUM(p) - WORD_SIZE))->size; +} + +inline static void mark_normal_obj(struct mpage *page, void *ptr) +{ + switch(page->page_type) { + case PAGE_TAGGED: { + /* we do not want to mark the pointers in a thread or custodian + unless the object's owner is the current owner. In the case + of threads, we already used it for roots, so we can just + ignore them outright. In the case of custodians, we do need + to do the check; those differences are handled by replacing + the mark procedure in mark_table. */ + mark_table[*(unsigned short*)ptr](ptr); + break; + } + case PAGE_ATOMIC: break; + case PAGE_ARRAY: { + struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); + void **temp = ptr, **end = temp + (info->size - 1); + + while(temp < end) gcMARK(*(temp++)); + break; + }; + case PAGE_TARRAY: { + struct objhead *info = (struct objhead *)((char*)ptr - WORD_SIZE); + unsigned short tag = *(unsigned short*)ptr; + void **temp = ptr, **end = PPTR(info) + (info->size - INSET_WORDS); + + while(temp < end) temp += mark_table[tag](temp); + break; + } + case PAGE_XTAGGED: GC_mark_xtagged(ptr); break; + } +} + +inline static void mark_acc_big_page(struct mpage *page) +{ + void **start = PPTR(NUM(page->addr) + PREFIX_SIZE + WORD_SIZE); + void **end = PPTR(NUM(page->addr) + page->size); + + switch(page->page_type) { + case PAGE_TAGGED: + { + unsigned short tag = *(unsigned short*)start; + if((unsigned long)mark_table[tag] < PAGE_TYPES) { + /* atomic */ + } else + mark_table[tag](start); break; + } + case PAGE_ATOMIC: break; + case PAGE_ARRAY: while(start < end) gcMARK(*(start++)); break; + case PAGE_XTAGGED: GC_mark_xtagged(start); break; + case PAGE_TARRAY: { + unsigned short tag = *(unsigned short *)start; + end -= INSET_WORDS; + while(start < end) start += mark_table[tag](start); + break; + } + } +} + +int kill_propagation_loop = 0; + +static void btc_overmem_abort() +{ + kill_propagation_loop = 1; + GCWARN((GCOUTF, "WARNING: Ran out of memory accounting. " + "Info will be wrong.\n")); +} + +static void propagate_accounting_marks(void) +{ + struct mpage *page; + void *p; + + while(pop_ptr(&p) && !kill_propagation_loop) { + page = find_page(p); + set_backtrace_source(p, page->page_type); + GCDEBUG((DEBUGOUTF, "btc_account: popped off page %p:%p, ptr %p\n", page, page->addr, p)); + if(page->big_page) + mark_acc_big_page(page); + else + mark_normal_obj(page, p); + } + if(kill_propagation_loop) + reset_pointer_stack(); +} + +static void do_btc_accounting(void) +{ + if(really_doing_accounting) { + Scheme_Custodian *cur = owner_table[current_owner(NULL)]->originator; + Scheme_Custodian_Reference *box = cur->global_next; + int i; + + GCDEBUG((DEBUGOUTF, "\nBEGINNING MEMORY ACCOUNTING\n")); + doing_memory_accounting = 1; + in_unsafe_allocation_mode = 1; + unsafe_allocation_abort = btc_overmem_abort; + + if(!normal_thread_mark) { + normal_thread_mark = mark_table[scheme_thread_type]; + normal_custodian_mark = mark_table[scheme_custodian_type]; + normal_cust_box_mark = mark_table[GC->cust_box_tag]; + } + mark_table[scheme_thread_type] = &BTC_thread_mark; + mark_table[scheme_custodian_type] = &BTC_custodian_mark; + mark_table[GC->ephemeron_tag] = btc_mark_ephemeron; + mark_table[GC->cust_box_tag] = BTC_cust_box_mark; + + /* clear the memory use numbers out */ + for(i = 1; i < owner_table_top; i++) + if(owner_table[i]) + owner_table[i]->memory_use = 0; + + /* the end of the custodian list is where we want to start */ + while(SCHEME_PTR1_VAL(box)) { + cur = (Scheme_Custodian*)SCHEME_PTR1_VAL(box); + box = cur->global_next; + } + + /* walk backwards for the order we want */ + while(cur) { + int owner = custodian_to_owner_set(cur); + + current_mark_owner = owner; + GCDEBUG((DEBUGOUTF,"MARKING THREADS OF OWNER %i (CUST %p)\n", + owner, cur)); + kill_propagation_loop = 0; + mark_threads(owner); + mark_cust_boxes(cur); + GCDEBUG((DEBUGOUTF, "Propagating accounting marks\n")); + propagate_accounting_marks(); + + box = cur->global_prev; cur = box ? SCHEME_PTR1_VAL(box) : NULL; + } + + mark_table[scheme_thread_type] = normal_thread_mark; + mark_table[scheme_custodian_type] = normal_custodian_mark; + mark_table[GC->ephemeron_tag] = mark_ephemeron; + mark_table[GC->cust_box_tag] = normal_cust_box_mark; + in_unsafe_allocation_mode = 0; + doing_memory_accounting = 0; + old_btc_mark = new_btc_mark; + new_btc_mark = !new_btc_mark; + } + clear_stack_pages(); +} + +struct account_hook { + int type; + void *c1, *c2; + unsigned long amount; + struct account_hook *next; +}; + +static struct account_hook *hooks = NULL; + +inline static void add_account_hook(int type,void *c1,void *c2,unsigned long b) +{ + struct account_hook *work; + + if(!really_doing_accounting) { + park[0] = c1; park[1] = c2; + really_doing_accounting = 1; + garbage_collect(1); + c1 = park[0]; c2 = park[1]; + park[0] = park[1] = NULL; + } + + if (type == MZACCT_LIMIT) + reset_limits = 1; + if (type == MZACCT_REQUIRE) + reset_required = 1; + + for(work = hooks; work; work = work->next) { + if((work->type == type) && (work->c2 == c2) && (work->c1 == c1)) { + if(type == MZACCT_REQUIRE) { + if(b > work->amount) work->amount = b; + } else { /* (type == MZACCT_LIMIT) */ + if(b < work->amount) work->amount = b; + } + break; + } + } + + if(!work) { + work = malloc(sizeof(struct account_hook)); + work->type = type; work->c1 = c1; work->c2 = c2; work->amount = b; + work->next = hooks; hooks = work; + } +} + +inline static void clean_up_account_hooks() +{ + struct account_hook *work = hooks, *prev = NULL; + + while(work) { + if((!work->c1 || marked(work->c1)) && marked(work->c2)) { + work->c1 = GC_resolve(work->c1); + work->c2 = GC_resolve(work->c2); + prev = work; work = work->next; + } else { + struct account_hook *next = work->next; + + if(prev) prev->next = next; + if(!prev) hooks = next; + free(work); + work = next; + } + } +} + +static unsigned long custodian_super_require(void *c) +{ + int set = ((Scheme_Custodian *)c)->gc_owner_set; + + if (reset_required) { + int i; + for(i = 1; i < owner_table_top; i++) + if (owner_table[i]) + owner_table[i]->required_set = 0; + reset_required = 0; + } + + if (!owner_table[set]->required_set) { + unsigned long req = 0, r; + struct account_hook *work = hooks; + + while(work) { + if ((work->type == MZACCT_REQUIRE) && (c == work->c2)) { + r = work->amount + custodian_super_require(work->c1); + if (r > req) + req = r; + } + work = work->next; + } + owner_table[set]->super_required = req; + owner_table[set]->required_set = 1; + } + + return owner_table[set]->super_required; +} + +inline static void run_account_hooks() +{ + struct account_hook *work = hooks, *prev = NULL; + + while(work) { + if( ((work->type == MZACCT_REQUIRE) && + ((used_pages > (max_used_pages / 2)) + || ((((max_used_pages / 2) - used_pages) * APAGE_SIZE) + < (work->amount + custodian_super_require(work->c1))))) + || + ((work->type == MZACCT_LIMIT) && + (GC_get_memory_use(work->c1) > work->amount))) { + struct account_hook *next = work->next; + + if(prev) prev->next = next; + if(!prev) hooks = next; + scheme_schedule_custodian_close(work->c2); + free(work); + work = next; + } else { + prev = work; work = work->next; + } + } +} + +static unsigned long custodian_single_time_limit(int set) +{ + if (!set) + return (unsigned long)(long)-1; + + if (reset_limits) { + int i; + for(i = 1; i < owner_table_top; i++) + if (owner_table[i]) + owner_table[i]->limit_set = 0; + reset_limits = 0; + } + + if (!owner_table[set]->limit_set) { + /* Check for limits on this custodian or one of its ancestors: */ + unsigned long limit = (unsigned long)(long)-1; + Scheme_Custodian *orig = owner_table[set]->originator, *c; + struct account_hook *work = hooks; + + while(work) { + if ((work->type == MZACCT_LIMIT) && (work->c1 == work->c2)) { + c = orig; + while (1) { + if (work->c2 == c) { + if (work->amount < limit) + limit = work->amount; + break; + } + if (!c->parent) + break; + c = (Scheme_Custodian*)SCHEME_PTR1_VAL(c->parent); + if (!c) + break; + } + } + work = work->next; + } + owner_table[set]->single_time_limit = limit; + owner_table[set]->limit_set = 1; + } + + return owner_table[set]->single_time_limit; +} + + +# define set_account_hook(a,b,c,d) { add_account_hook(a,b,c,d); return 1; } +# define set_btc_mark(x) (((struct objhead *)(x))->btc_mark = old_btc_mark) +#endif + +#ifndef NEWGC_BTC_ACCOUNT +# define clean_up_owner_table() /* */ +# define do_btc_accounting() /* */ +# define doing_memory_accounting 0 +# define memory_account_mark(p,o) /* */ +# define set_account_hook(a,b,c,d) return 0 +# define clean_up_account_hooks() /* */ +# define run_account_hooks() /* */ +# define custodian_usage(cust) 0 +# define set_btc_mark(x) /* */ +static unsigned long custodian_single_time_limit(int set) +{ + return (unsigned long)(long)-1; +} +#endif