Back to index

plt-scheme  4.2.1
mem_account.c
Go to the documentation of this file.
00001 /*****************************************************************************/
00002 /* memory accounting                                                         */
00003 /*****************************************************************************/
00004 #ifdef NEWGC_BTC_ACCOUNT
00005 
00006 #include "../src/schpriv.h"
00007 /* BTC_ prefixed functions are called by newgc.c */
00008 /* btc_ prefixed functions are internal to mem_account.c */
00009 
00010 static const int btc_redirect_thread    = 511;
00011 static const int btc_redirect_custodian = 510;
00012 static const int btc_redirect_ephemeron = 509;
00013 static const int btc_redirect_cust_box  = 508;
00014 
00015 /*****************************************************************************/
00016 /* thread list                                                               */
00017 /*****************************************************************************/
00018 inline static int current_owner(NewGC *gc, Scheme_Custodian *c);
00019 
00020 inline static void BTC_register_new_thread(void *t, void *c)
00021 {
00022   NewGC *gc = GC_get_GC();
00023   GC_Thread_Info *work;
00024 
00025   work = (GC_Thread_Info *)ofm_malloc(sizeof(GC_Thread_Info));
00026   ((Scheme_Thread *)t)->gc_info = work;
00027   work->owner = current_owner(gc, (Scheme_Custodian *)c);
00028   work->thread = t;
00029 
00030   work->next = gc->thread_infos;
00031   gc->thread_infos = work;
00032 }
00033 
00034 inline static void BTC_register_thread(void *t, void *c)
00035 {
00036   NewGC *gc = GC_get_GC();
00037   GC_Thread_Info *work;
00038 
00039   work = ((Scheme_Thread *)t)->gc_info;
00040   work->owner = current_owner(gc, (Scheme_Custodian *)c);
00041 }
00042 
00043 inline static void mark_threads(NewGC *gc, int owner)
00044 {
00045   GC_Thread_Info *work;
00046   Mark_Proc thread_mark = gc->mark_table[btc_redirect_thread];
00047 
00048   for(work = gc->thread_infos; work; work = work->next)
00049     if(work->owner == owner) {
00050       if (((Scheme_Thread *)work->thread)->running) {
00051         thread_mark(work->thread);
00052         if (work->thread == scheme_current_thread) {
00053           GC_mark_variable_stack(GC_variable_stack, 0, get_stack_base(gc), NULL);
00054         }
00055       }
00056     }
00057 }
00058 
00059 inline static void clean_up_thread_list(NewGC *gc)
00060 {
00061   GC_Thread_Info *work = gc->thread_infos;
00062   GC_Thread_Info *prev = NULL;
00063 
00064   while(work) {
00065     if(!pagemap_find_page(gc->page_maps, work->thread) || marked(gc, work->thread)) {
00066       work->thread = GC_resolve(work->thread);
00067       prev = work;
00068       work = work->next;
00069     } else {
00070       GC_Thread_Info *next = work->next;
00071 
00072       if(prev) prev->next = next;
00073       if(!prev) gc->thread_infos = next;
00074       free(work);
00075       work = next;
00076     }
00077   }
00078 }
00079 
00080 inline static int thread_get_owner(void *p)
00081 {
00082   return ((Scheme_Thread *)p)->gc_info->owner;
00083 }
00084 
00085 #define OWNER_TABLE_INIT_AMT 10
00086 
00087 inline static int create_blank_owner_set(NewGC *gc)
00088 {
00089   int i;
00090   unsigned int curr_size = gc->owner_table_size;
00091   OTEntry **owner_table = gc->owner_table;
00092   unsigned int old_size;
00093   OTEntry **naya;
00094 
00095   for (i = 1; i < curr_size; i++) {
00096     if (!owner_table[i]) {
00097       owner_table[i] = ofm_malloc(sizeof(OTEntry));
00098       bzero(owner_table[i], sizeof(OTEntry));
00099       return i;
00100     }
00101   }
00102 
00103   old_size = curr_size;
00104   if (!curr_size) {
00105     curr_size = OWNER_TABLE_INIT_AMT;
00106   }
00107   else {
00108     curr_size *= 2;
00109   }
00110   gc->owner_table_size = curr_size;
00111 
00112   naya = (OTEntry **)ofm_malloc(curr_size * sizeof(OTEntry*));
00113   memcpy(naya, owner_table, old_size*sizeof(OTEntry*));
00114   gc->owner_table = owner_table = naya;
00115   bzero(((char*)owner_table) + (sizeof(OTEntry*) * old_size),
00116       (curr_size - old_size) * sizeof(OTEntry*));
00117 
00118   return create_blank_owner_set(gc);
00119 }
00120 
00121 inline static int custodian_to_owner_set(NewGC *gc,Scheme_Custodian *cust)
00122 {
00123   int i;
00124 
00125   if (cust->gc_owner_set)
00126     return cust->gc_owner_set;
00127 
00128   i = create_blank_owner_set(gc);
00129   gc->owner_table[i]->originator = cust;
00130   cust->gc_owner_set = i;
00131 
00132   return i;
00133 }
00134 
00135 inline static int current_owner(NewGC *gc, Scheme_Custodian *c)
00136 {
00137   if (!scheme_current_thread)
00138     return 1;
00139   else if (!c)
00140     return thread_get_owner(scheme_current_thread);
00141   else
00142     return custodian_to_owner_set(gc, c);
00143 }
00144 
00145 void BTC_register_root_custodian(void *_c)
00146 {
00147   NewGC *gc = GC_get_GC();
00148   Scheme_Custodian *c = (Scheme_Custodian *)_c;
00149 
00150   if (gc->owner_table) {
00151     /* Reset */
00152     free(gc->owner_table);
00153     gc->owner_table = NULL;
00154     gc->owner_table_size = 0;
00155   }
00156 
00157   if (create_blank_owner_set(gc) != 1) {
00158     GCPRINT(GCOUTF, "Something extremely weird (and bad) has happened.\n");
00159     abort();
00160   }
00161 
00162   gc->owner_table[1]->originator = c;
00163   c->gc_owner_set = 1;
00164 }
00165 
00166 inline static int custodian_member_owner_set(NewGC *gc, void *cust, int set)
00167 {
00168   Scheme_Custodian_Reference *box;
00169   Scheme_Custodian *work = (Scheme_Custodian *) gc->owner_table[set]->originator;
00170 
00171   while(work) {
00172     if(work == cust) return 1;
00173     box = work->parent;
00174     work = box ? SCHEME_PTR1_VAL(box) : NULL;
00175   }
00176   return 0;
00177 }
00178 
00179 inline static void account_memory(NewGC *gc, int set, long amount)
00180 {
00181   gc->owner_table[set]->memory_use += amount;
00182 }
00183 
00184 inline static void free_owner_set(NewGC *gc, int set)
00185 {
00186   OTEntry **owner_table = gc->owner_table;
00187   if(owner_table[set]) {
00188     free(owner_table[set]);
00189   }
00190   owner_table[set] = NULL;
00191 }
00192 
00193 inline static void clean_up_owner_table(NewGC *gc)
00194 {
00195   OTEntry **owner_table = gc->owner_table;
00196   const int table_size = gc->owner_table_size;
00197   int i;
00198 
00199   for(i = 1; i < table_size; i++)
00200     if(owner_table[i]) {
00201       /* repair or delete the originator */
00202       if(!marked(gc, owner_table[i]->originator)) {
00203         owner_table[i]->originator = NULL;
00204       } else 
00205         owner_table[i]->originator = GC_resolve(owner_table[i]->originator);
00206 
00207       /* potential delete */
00208       if(i != 1) 
00209         if((owner_table[i]->memory_use == 0) && !owner_table[i]->originator)
00210           free_owner_set(gc, i);
00211     }
00212 }
00213 
00214 inline static unsigned long custodian_usage(NewGC*gc, void *custodian)
00215 {
00216   OTEntry **owner_table;
00217   unsigned long retval = 0;
00218   int i;
00219 
00220   if(!gc->really_doing_accounting) {
00221     gc->park[0] = custodian;
00222     gc->really_doing_accounting = 1;
00223     garbage_collect(gc, 1);
00224     custodian = gc->park[0]; 
00225     gc->park[0] = NULL;
00226   }
00227 
00228   i = custodian_to_owner_set(gc, (Scheme_Custodian *)custodian);
00229 
00230   owner_table = gc->owner_table;
00231   if (owner_table[i])
00232     retval = owner_table[i]->memory_use;
00233   else
00234     retval = 0;
00235 
00236   return gcWORDS_TO_BYTES(retval);
00237 }
00238 
00239 inline static void BTC_memory_account_mark(NewGC *gc, mpage *page, void *ptr)
00240 {
00241   GCDEBUG((DEBUGOUTF, "BTC_memory_account_mark: %p/%p\n", page, ptr));
00242   if(page->size_class) {
00243     if(page->size_class > 1) {
00244       /* big page */
00245       objhead *info = BIG_PAGE_TO_OBJHEAD(page);
00246       
00247       if(info->btc_mark == gc->old_btc_mark) {
00248         info->btc_mark = gc->new_btc_mark;
00249         account_memory(gc, gc->current_mark_owner, gcBYTES_TO_WORDS(page->size));
00250         push_ptr(ptr);
00251       }
00252     } else {
00253       /* medium page */
00254       objhead *info = MED_OBJHEAD(ptr, page->size);
00255 
00256       if(info->btc_mark == gc->old_btc_mark) {
00257         info->btc_mark = gc->new_btc_mark;
00258         account_memory(gc, gc->current_mark_owner, info->size);
00259         ptr = OBJHEAD_TO_OBJPTR(info);
00260         push_ptr(ptr);
00261       }
00262     }
00263   } else {
00264     objhead *info = OBJPTR_TO_OBJHEAD(ptr);
00265 
00266     if(info->btc_mark == gc->old_btc_mark) {
00267       info->btc_mark = gc->new_btc_mark;
00268       account_memory(gc, gc->current_mark_owner, info->size);
00269       push_ptr(ptr);
00270     }
00271   }
00272 }
00273 
00274 inline static void mark_cust_boxes(NewGC *gc, Scheme_Custodian *cur)
00275 {
00276   Scheme_Object *pr, *prev = NULL, *next;
00277   GC_Weak_Box *wb;
00278   Mark_Proc cust_box_mark = gc->mark_table[btc_redirect_cust_box];
00279 
00280   /* cust boxes is a list of weak boxes to cust boxes */
00281 
00282   pr = cur->cust_boxes;
00283   while (pr) {
00284     wb = (GC_Weak_Box *)SCHEME_CAR(pr);
00285     next = SCHEME_CDR(pr);
00286     if (wb->val) {
00287       cust_box_mark(wb->val);
00288       prev = pr;
00289     } else {
00290       if (prev)
00291         SCHEME_CDR(prev) = next;
00292       else
00293         cur->cust_boxes = next;
00294       --cur->num_cust_boxes;
00295     }
00296     pr = next;
00297   }
00298   cur->checked_cust_boxes = cur->num_cust_boxes;
00299 }
00300 
00301 int BTC_thread_mark(void *p)
00302 {
00303   NewGC *gc = GC_get_GC();
00304   if (gc->doing_memory_accounting) {
00305     return OBJPTR_TO_OBJHEAD(p)->size;
00306   }
00307   return gc->mark_table[btc_redirect_thread](p);
00308 }
00309 
00310 int BTC_custodian_mark(void *p)
00311 {
00312   NewGC *gc = GC_get_GC();
00313   if (gc->doing_memory_accounting) {
00314     if(custodian_to_owner_set(gc, p) == gc->current_mark_owner)
00315       return gc->mark_table[btc_redirect_custodian](p);
00316     else
00317       return OBJPTR_TO_OBJHEAD(p)->size;
00318   }
00319   return gc->mark_table[btc_redirect_custodian](p);
00320 }
00321 
00322 int BTC_cust_box_mark(void *p)
00323 {
00324   NewGC *gc = GC_get_GC();
00325   if (gc->doing_memory_accounting) {
00326     return OBJPTR_TO_OBJHEAD(p)->size;
00327   }
00328   return gc->mark_table[btc_redirect_cust_box](p);
00329 }
00330 
00331 inline static void mark_normal_obj(NewGC *gc, int type, void *ptr)
00332 {
00333   switch(type) {
00334     case PAGE_TAGGED: {
00335                         /* we do not want to mark the pointers in a thread or custodian 
00336                            unless the object's owner is the current owner. In the case
00337                            of threads, we already used it for roots, so we can just
00338                            ignore them outright. In the case of custodians, we do need
00339                            to do the check; those differences are handled by replacing
00340                            the mark procedure in mark_table. */
00341                         gc->mark_table[*(unsigned short*)ptr](ptr);
00342                         break;
00343                       }
00344     case PAGE_ATOMIC: break;
00345     case PAGE_ARRAY: { 
00346                        objhead *info = OBJPTR_TO_OBJHEAD(ptr);
00347                        void **temp = ptr;
00348                        void **end  = PPTR(info) + info->size;
00349 
00350                        while(temp < end) gcMARK(*(temp++));
00351                        break;
00352                      };
00353     case PAGE_TARRAY: {
00354                         objhead *info = OBJPTR_TO_OBJHEAD(ptr);
00355                         unsigned short tag = *(unsigned short*)ptr;
00356                         void **temp = ptr;
00357                         void **end = PPTR(info) + (info->size - INSET_WORDS);
00358 
00359                         while(temp < end) temp += gc->mark_table[tag](temp);
00360                         break;
00361                       }
00362     case PAGE_XTAGGED: GC_mark_xtagged(ptr); break;
00363   }
00364 }
00365 
00366 inline static void mark_acc_big_page(NewGC *gc, mpage *page)
00367 {
00368   void **start = PPTR(BIG_PAGE_TO_OBJECT(page));
00369   void **end = PPTR(NUM(page->addr) + page->size);
00370 
00371   switch(page->page_type) {
00372     case PAGE_TAGGED: 
00373       {
00374         unsigned short tag = *(unsigned short*)start;
00375         if((unsigned long)gc->mark_table[tag] < PAGE_TYPES) {
00376           /* atomic */
00377         } else
00378           gc->mark_table[tag](start); break;
00379       }
00380     case PAGE_ATOMIC: break;
00381     case PAGE_ARRAY: while(start < end) gcMARK(*(start++)); break;
00382     case PAGE_XTAGGED: GC_mark_xtagged(start); break;
00383     case PAGE_TARRAY: {
00384                         unsigned short tag = *(unsigned short *)start;
00385                         end -= INSET_WORDS;
00386                         while(start < end) start += gc->mark_table[tag](start);
00387                         break;
00388                       }
00389   }
00390 }
00391 
00392 static void btc_overmem_abort(NewGC *gc)
00393 {
00394   gc->kill_propagation_loop = 1;
00395   GCWARN((GCOUTF, "WARNING: Ran out of memory accounting. "
00396         "Info will be wrong.\n"));
00397 }
00398 
00399 static void propagate_accounting_marks(NewGC *gc)
00400 {
00401   struct mpage *page;
00402   void *p;
00403   PageMap pagemap = gc->page_maps;
00404   while(pop_ptr(&p) && !gc->kill_propagation_loop) {
00405     page = pagemap_find_page(pagemap, p);
00406     set_backtrace_source(p, page->page_type);
00407     GCDEBUG((DEBUGOUTF, "btc_account: popped off page %p:%p, ptr %p\n", page, page->addr, p));
00408     if(page->size_class) {
00409       if (page->size_class > 1)
00410         mark_acc_big_page(gc, page);
00411       else {
00412         objhead *info = MED_OBJHEAD(p, page->size);
00413         p = OBJHEAD_TO_OBJPTR(info);
00414         mark_normal_obj(gc, info->type, p);
00415       }
00416     } else
00417       mark_normal_obj(gc, page->page_type, p);
00418   }
00419   if(gc->kill_propagation_loop)
00420     reset_pointer_stack();
00421 }
00422 
00423 inline static void BTC_initialize_mark_table(NewGC *gc) {
00424   gc->mark_table[scheme_thread_type]    = BTC_thread_mark;
00425   gc->mark_table[scheme_custodian_type] = BTC_custodian_mark;
00426   gc->mark_table[gc->ephemeron_tag]     = BTC_ephemeron_mark;
00427   gc->mark_table[gc->cust_box_tag]      = BTC_cust_box_mark;
00428 }
00429 
00430 inline static int BTC_get_redirect_tag(NewGC *gc, int tag) {
00431   if (tag == scheme_thread_type )         { tag = btc_redirect_thread; }
00432   else if (tag == scheme_custodian_type ) { tag = btc_redirect_custodian; }
00433   else if (tag == gc->ephemeron_tag )     { tag = btc_redirect_ephemeron; }
00434   else if (tag == gc->cust_box_tag )      { tag = btc_redirect_cust_box; }
00435   return tag;
00436 }
00437 
00438 static void BTC_do_accounting(NewGC *gc)
00439 {
00440   const int table_size = gc->owner_table_size;
00441   OTEntry **owner_table = gc->owner_table;
00442 
00443   if(gc->really_doing_accounting) {
00444     Scheme_Custodian *cur = owner_table[current_owner(gc, NULL)]->originator, *last, *parent;
00445     Scheme_Custodian_Reference *box = cur->global_next;
00446     int i;
00447 
00448     GCDEBUG((DEBUGOUTF, "\nBEGINNING MEMORY ACCOUNTING\n"));
00449     gc->doing_memory_accounting = 1;
00450     gc->in_unsafe_allocation_mode = 1;
00451     gc->unsafe_allocation_abort = btc_overmem_abort;
00452 
00453     /* clear the memory use numbers out */
00454     for(i = 1; i < table_size; i++)
00455       if(owner_table[i])
00456         owner_table[i]->memory_use = 0;
00457     
00458     /* start with root: */
00459     while (cur->parent && SCHEME_PTR1_VAL(cur->parent)) {
00460       cur = SCHEME_PTR1_VAL(cur->parent);
00461     }
00462 
00463     /* walk forward for the order we want (blame parents instead of children) */
00464     last = cur;
00465     while(cur) {
00466       int owner = custodian_to_owner_set(gc, cur);
00467 
00468       gc->current_mark_owner = owner;
00469       GCDEBUG((DEBUGOUTF,"MARKING THREADS OF OWNER %i (CUST %p)\n", owner, cur));
00470       gc->kill_propagation_loop = 0;
00471       mark_threads(gc, owner);
00472       mark_cust_boxes(gc, cur);
00473       GCDEBUG((DEBUGOUTF, "Propagating accounting marks\n"));
00474       propagate_accounting_marks(gc);
00475 
00476       last = cur;
00477       box = cur->global_next; cur = box ? SCHEME_PTR1_VAL(box) : NULL;
00478     }
00479 
00480     /* walk backward folding totals int parent */
00481     cur = last;
00482     while (cur) {
00483       int owner = custodian_to_owner_set(gc, cur);
00484       
00485       box = cur->parent; parent = box ? SCHEME_PTR1_VAL(box) : NULL;
00486       if (parent) {
00487         int powner = custodian_to_owner_set(gc, parent);
00488 
00489         owner_table = gc->owner_table;
00490         owner_table[powner]->memory_use += owner_table[owner]->memory_use;
00491       }
00492 
00493       box = cur->global_prev; cur = box ? SCHEME_PTR1_VAL(box) : NULL;
00494     }
00495 
00496     gc->in_unsafe_allocation_mode = 0;
00497     gc->doing_memory_accounting = 0;
00498     gc->old_btc_mark = gc->new_btc_mark;
00499     gc->new_btc_mark = !gc->new_btc_mark;
00500   }
00501 
00502   clear_stack_pages();
00503 }
00504 
00505 inline static void BTC_add_account_hook(int type,void *c1,void *c2,unsigned long b)
00506 {
00507   NewGC *gc = GC_get_GC();
00508   AccountHook *work;
00509 
00510   if(!gc->really_doing_accounting) {
00511     gc->park[0] = c1; 
00512     gc->park[1] = c2;
00513     gc->really_doing_accounting = 1;
00514     garbage_collect(gc, 1);
00515     c1 = gc->park[0]; gc->park[0] = NULL;
00516     c2 = gc->park[1]; gc->park[1] = NULL;
00517   }
00518 
00519   if (type == MZACCT_LIMIT)
00520     gc->reset_limits = 1;
00521   if (type == MZACCT_REQUIRE)
00522     gc->reset_required = 1;
00523 
00524   for(work = gc->hooks; work; work = work->next) {
00525     if((work->type == type) && (work->c2 == c2) && (work->c1 == c1)) {
00526       if(type == MZACCT_REQUIRE) {
00527         if(b > work->amount) work->amount = b;
00528       } else { /* (type == MZACCT_LIMIT) */
00529         if(b < work->amount) work->amount = b;
00530       }
00531       break;
00532     } 
00533   }
00534 
00535   if(!work) {
00536     work = ofm_malloc(sizeof(AccountHook));
00537     work->type = type; 
00538     work->c1 = c1; 
00539     work->c2 = c2; 
00540     work->amount = b;
00541 
00542     /* push work onto hooks */
00543     work->next = gc->hooks;
00544     gc->hooks = work;
00545   }
00546 }
00547 
00548 inline static void clean_up_account_hooks(NewGC *gc)
00549 {
00550   AccountHook *work = gc->hooks;
00551   AccountHook *prev = NULL;
00552 
00553   while(work) {
00554     if((!work->c1 || marked(gc, work->c1)) && marked(gc, work->c2)) {
00555       work->c1 = GC_resolve(work->c1);
00556       work->c2 = GC_resolve(work->c2);
00557       prev = work;
00558       work = work->next;
00559     } else {
00560       /* remove work hook */
00561       AccountHook *next = work->next;
00562 
00563       if(prev) prev->next = next;
00564       if(!prev) gc->hooks = next;
00565       free(work);
00566       work = next;
00567     }
00568   }
00569 }
00570 
00571 static unsigned long custodian_super_require(NewGC *gc, void *c)
00572 {
00573   int set = ((Scheme_Custodian *)c)->gc_owner_set;
00574   const int table_size = gc->owner_table_size;
00575   OTEntry **owner_table = gc->owner_table;
00576 
00577   if (gc->reset_required) {
00578     int i;
00579     for(i = 1; i < table_size; i++)
00580       if (owner_table[i])
00581         owner_table[i]->required_set = 0;
00582     gc->reset_required = 0;
00583   }
00584 
00585   if (!owner_table[set]->required_set) {
00586     unsigned long req = 0, r;
00587     AccountHook *work = gc->hooks;
00588 
00589     while(work) {
00590       if ((work->type == MZACCT_REQUIRE) && (c == work->c2)) {
00591         r = work->amount + custodian_super_require(gc, work->c1);
00592         if (r > req)
00593           req = r;
00594       }
00595       work = work->next;
00596     }
00597     owner_table[set]->super_required = req;
00598     owner_table[set]->required_set = 1;
00599   }
00600 
00601   return owner_table[set]->super_required;
00602 }
00603 
00604 inline static void BTC_run_account_hooks(NewGC *gc)
00605 {
00606   AccountHook *work = gc->hooks; 
00607   AccountHook *prev = NULL;
00608 
00609   while(work) {
00610     if( ((work->type == MZACCT_REQUIRE) && 
00611           ((gc->used_pages > (gc->max_pages_for_use / 2))
00612            || ((((gc->max_pages_for_use / 2) - gc->used_pages) * APAGE_SIZE)
00613                < (work->amount + custodian_super_require(gc, work->c1)))))
00614         ||
00615         ((work->type == MZACCT_LIMIT) &&
00616          (GC_get_memory_use(work->c1) > work->amount))) {
00617       AccountHook *next = work->next;
00618 
00619       if(prev) prev->next = next;
00620       if(!prev) gc->hooks = next;
00621       scheme_schedule_custodian_close(work->c2);
00622       free(work);
00623       work = next;
00624     } else {
00625       prev = work; 
00626       work = work->next;
00627     }
00628   }
00629 }
00630 
00631 static unsigned long custodian_single_time_limit(NewGC *gc, int set)
00632 {
00633   OTEntry **owner_table = gc->owner_table;
00634   const int table_size = gc->owner_table_size;
00635 
00636   if (!set)
00637     return (unsigned long)(long)-1;
00638 
00639   if (gc->reset_limits) {
00640     int i;
00641     for(i = 1; i < table_size; i++)
00642       if (owner_table[i])
00643         owner_table[i]->limit_set = 0;
00644     gc->reset_limits = 0;
00645   }
00646 
00647   if (!owner_table[set]->limit_set) {
00648     /* Check for limits on this custodian or one of its ancestors: */
00649     unsigned long limit = (unsigned long)(long)-1;
00650     Scheme_Custodian *orig = (Scheme_Custodian *) owner_table[set]->originator, *c;
00651     AccountHook *work = gc->hooks;
00652 
00653     while(work) {
00654       if ((work->type == MZACCT_LIMIT) && (work->c1 == work->c2)) {
00655         c = orig;
00656         while (1) {
00657           if (work->c2 == c) {
00658             if (work->amount < limit)
00659               limit = work->amount;
00660             break;
00661           }
00662           if (!c->parent)
00663             break;
00664           c = (Scheme_Custodian*)SCHEME_PTR1_VAL(c->parent);
00665           if (!c)
00666             break;
00667         }
00668       }
00669       work = work->next;
00670     }
00671     owner_table[set]->single_time_limit = limit;
00672     owner_table[set]->limit_set = 1;
00673   }
00674 
00675   return owner_table[set]->single_time_limit;
00676 }
00677 
00678 long BTC_get_memory_use(NewGC* gc, void *o)
00679 {
00680   Scheme_Object *arg = (Scheme_Object*)o;
00681   if(SAME_TYPE(SCHEME_TYPE(arg), scheme_custodian_type)) {
00682     return custodian_usage(gc, arg);
00683   }
00684 
00685   return 0;
00686 }
00687 
00688 int BTC_single_allocation_limit(NewGC *gc, size_t sizeb) {
00689   /* We're allowed to fail. Check for allocations that exceed a single-time
00690    * limit. Otherwise, the limit doesn't work as intended, because
00691    * a program can allocate a large block that nearly exhausts memory,
00692    * and then a subsequent allocation can fail. As long as the limit
00693    * is much smaller than the actual available memory, and as long as
00694    * GC_out_of_memory protects any user-requested allocation whose size
00695    * is independent of any existing object, then we can enforce the limit. */
00696   return (custodian_single_time_limit(gc, thread_get_owner(scheme_current_thread)) < sizeb);
00697 }
00698 
00699 static inline void BTC_clean_up(NewGC *gc) {
00700   clean_up_thread_list(gc);
00701   clean_up_owner_table(gc);
00702   clean_up_account_hooks(gc);
00703 }
00704 
00705 static inline void BTC_set_btc_mark(NewGC *gc, objhead* info) {
00706   info->btc_mark = gc->old_btc_mark;
00707 }
00708 #endif