diff --git a/collects/scribblings/reference/memory.scrbl b/collects/scribblings/reference/memory.scrbl index 0a8c7fe9c0..f8df99ad25 100644 --- a/collects/scribblings/reference/memory.scrbl +++ b/collects/scribblings/reference/memory.scrbl @@ -170,15 +170,19 @@ execution. Otherwise, @racket[#f] is returned.} @;------------------------------------------------------------------------ @section[#:tag "garbagecollection"]{Garbage Collection} +Set the @as-index{@envvar{PLTDISABLEGC}} environment variable (to any +value) before Racket starts to disable @tech{garbage collection}. + @defproc[(collect-garbage) void?]{ -Forces an immediate garbage collection. Some effectively unreachable -data may remain uncollected, because the collector cannot prove that -it is unreachable. +Forces an immediate @tech{garbage collection} (unless garbage +collection is disabled by setting @envvar{PLTDISABLEGC}). Some +effectively unreachable data may remain uncollected, because the +collector cannot prove that it is unreachable. The @racket[collect-garbage] procedure provides some control over the timing of collections, but garbage will obviously be collected even if -this procedure is never called.} +this procedure is never called (unless garbage collection is disabled).} @defproc[(current-memory-use [cust custodian? #f]) exact-nonnegative-integer?]{ diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index 0bb469b694..a836aab046 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -1140,6 +1140,9 @@ static int run_from_cmd_line(int argc, char *_argv[], stderr_level = get_log_level(prog, NULL, "PLTSTDERR", "stderr", s); } } + if (getenv("PLTDISABLEGC")) { + scheme_enable_garbage_collection(0); + } #endif scheme_set_logging(syslog_level, stderr_level); diff --git a/src/racket/gc2/gc2.h b/src/racket/gc2/gc2.h index 02f15308a0..f7e61cdb8d 100644 --- a/src/racket/gc2/gc2.h +++ b/src/racket/gc2/gc2.h @@ -154,6 +154,10 @@ GC2_EXTERN void GC_gcollect(void); /* Performs an immediate (full) collection. */ +GC2_EXTERN void GC_enable_collection(int on); +/* + Performs an immediate (full) collection. */ + GC2_EXTERN void GC_free_all(void); /* Releases all memory, removes all signal handlers, etc. diff --git a/src/racket/gc2/mem_account.c b/src/racket/gc2/mem_account.c index 685a566ad9..8e21d0e31a 100644 --- a/src/racket/gc2/mem_account.c +++ b/src/racket/gc2/mem_account.c @@ -218,11 +218,13 @@ inline static uintptr_t custodian_usage(NewGC*gc, void *custodian) int i; if(!gc->really_doing_accounting) { - gc->park[0] = custodian; - gc->really_doing_accounting = 1; - garbage_collect(gc, 1, 0, NULL); - custodian = gc->park[0]; - gc->park[0] = NULL; + if (!gc->dumping_avoid_collection) { + gc->park[0] = custodian; + gc->really_doing_accounting = 1; + garbage_collect(gc, 1, 0, NULL); + custodian = gc->park[0]; + gc->park[0] = NULL; + } } i = custodian_to_owner_set(gc, (Scheme_Custodian *)custodian); @@ -433,12 +435,14 @@ inline static void BTC_add_account_hook(int type,void *c1,void *c2,uintptr_t b) AccountHook *work; if(!gc->really_doing_accounting) { - gc->park[0] = c1; - gc->park[1] = c2; - gc->really_doing_accounting = 1; - garbage_collect(gc, 1, 0, NULL); - c1 = gc->park[0]; gc->park[0] = NULL; - c2 = gc->park[1]; gc->park[1] = NULL; + if (!gc->dumping_avoid_collection) { + gc->park[0] = c1; + gc->park[1] = c2; + gc->really_doing_accounting = 1; + garbage_collect(gc, 1, 0, NULL); + c1 = gc->park[0]; gc->park[0] = NULL; + c2 = gc->park[1]; gc->park[1] = NULL; + } } if (type == MZACCT_LIMIT) diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 84b8bc0a01..557a51f144 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -2517,6 +2517,7 @@ static void NewGC_initialize(NewGC *newgc, NewGC *parentgc) { if (parentgc) { newgc->mark_table = parentgc->mark_table; newgc->fixup_table = parentgc->fixup_table; + newgc->dumping_avoid_collection = parentgc->dumping_avoid_collection - 1; } else { @@ -2660,7 +2661,9 @@ void GC_switch_out_master_gc() { NewGC *gc = GC_get_GC(); initialized = 1; - garbage_collect(gc, 1, 1, NULL); + + if (!gc->dumping_avoid_collection) + garbage_collect(gc, 1, 1, NULL); #ifdef MZ_USE_PLACES GC_gen0_alloc_page_ptr = 2; @@ -2669,7 +2672,8 @@ void GC_switch_out_master_gc() { #endif MASTERGC = gc; - MASTERGC->dumping_avoid_collection = 1; + MASTERGC->dumping_avoid_collection++; + save_globals_to_gc(MASTERGC); GC_construct_child_gc(); GC_allow_master_gc_check(); @@ -2717,6 +2721,8 @@ void GC_gcollect(void) { NewGC *gc = GC_get_GC(); + if (gc->dumping_avoid_collection) return; + #ifdef MZ_USE_PLACES if (postmaster_and_master_gc(gc)) master_collect_initiate(gc); @@ -2725,6 +2731,16 @@ void GC_gcollect(void) garbage_collect(gc, 1, 0, NULL); } +void GC_enable_collection(int on) +{ + NewGC *gc = GC_get_GC(); + + if (on) + --gc->dumping_avoid_collection; + else + gc->dumping_avoid_collection++; +} + void GC_register_traversers2(short tag, Size2_Proc size, Mark2_Proc mark, Fixup2_Proc fixup, int constant_Size, int atomic) { diff --git a/src/racket/gc2/newgc.h b/src/racket/gc2/newgc.h index d0d1ad76fb..0a78298a3c 100644 --- a/src/racket/gc2/newgc.h +++ b/src/racket/gc2/newgc.h @@ -184,7 +184,6 @@ typedef struct NewGC { unsigned int owner_table_size; AccountHook *hooks; - uintptr_t number_of_gc_runs; unsigned int since_last_full; uintptr_t last_full_mem_use; diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 8711025f0d..83d0bf969b 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -209,6 +209,7 @@ EXPORTS scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage + scheme_disable_garbage_collection scheme_malloc_immobile_box scheme_free_immobile_box scheme_add_gc_callback diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index e0128e53b8..b657067316 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -218,6 +218,7 @@ EXPORTS scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage + scheme_disable_garbage_collection GC_variable_stack GC_register_traversers GC_resolve diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 07ade7f643..50baeb84ed 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -221,6 +221,7 @@ scheme_remove_all_finalization scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage +scheme_disable_garbage_collection GC_register_traversers GC_resolve GC_mark diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index e3068bc7f4..8505fd61b2 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -226,6 +226,7 @@ scheme_remove_all_finalization scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage +scheme_disable_garbage_collection GC_variable_stack GC_register_traversers GC_resolve diff --git a/src/racket/sgc/sgc.c b/src/racket/sgc/sgc.c index 73eefdfc9f..888f71dd4b 100644 --- a/src/racket/sgc/sgc.c +++ b/src/racket/sgc/sgc.c @@ -717,6 +717,8 @@ static MemoryChunk *sys_malloc_others; int GC_dl_entries; int GC_fo_entries; +int GC_dont_gc; + void (*GC_push_last_roots)(void); void (*GC_push_last_roots_again)(void); @@ -2440,7 +2442,7 @@ static void *do_malloc(SET_NO_BACKINFO block = (BlockOfMemory *)malloc_sector(c, sector_kind_block, 1); if (!block) { - if (mem_use >= mem_limit) { + if ((mem_use >= mem_limit) && !GC_dont_gc) { GC_gcollect(); return do_malloc(KEEP_SET_INFO_ARG(set_no) size, common, othersptr, flags); @@ -4745,6 +4747,9 @@ void GC_gcollect(void) if (!sector_mem_use) return; + if (GC_dont_gc) + return; + FLUSH_REGISTER_WINDOWS; if (!setjmp(buf)) do_GC_gcollect((void *)&dummy); diff --git a/src/racket/sgc/sgc.h b/src/racket/sgc/sgc.h index a94e85009b..30e8001408 100644 --- a/src/racket/sgc/sgc.h +++ b/src/racket/sgc/sgc.h @@ -106,6 +106,8 @@ SGC_EXTERN void GC_register_indirect_disappearing_link(void **p, void *a); SGC_EXTERN void (*GC_push_last_roots)(void); SGC_EXTERN void (*GC_push_last_roots_again)(void); +SGC_EXTERN int GC_dont_gc; + # ifdef __cplusplus }; # endif diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index 4bbb4fbd06..1553fbfb92 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -1645,6 +1645,18 @@ void scheme_collect_garbage(void) GC_gcollect(); } +void scheme_enable_garbage_collection(int on) +{ +#ifdef MZ_PRECISE_GC + GC_enable_collection(on); +#else + if (on) + --GC_dont_gc; + else + GC_dont_gc++; +#endif +} + uintptr_t scheme_get_deeper_address(void) { int v, *vp; diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 040b4bd845..b1d488161b 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -438,6 +438,7 @@ MZ_EXTERN void scheme_dont_gc_ptr(void *p); MZ_EXTERN void scheme_gc_ptr_ok(void *p); MZ_EXTERN void scheme_collect_garbage(void); +MZ_EXTERN void scheme_enable_garbage_collection(int on); #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index a3d19fef02..939ea4dddc 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -339,6 +339,7 @@ void (*scheme_remove_all_finalization)(void *p); void (*scheme_dont_gc_ptr)(void *p); void (*scheme_gc_ptr_ok)(void *p); void (*scheme_collect_garbage)(void); +void (*scheme_enable_garbage_collection)(int on); #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL void **GC_variable_stack; diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index bed31c6aaf..562b08b5b3 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -247,6 +247,7 @@ scheme_extension_table->scheme_dont_gc_ptr = scheme_dont_gc_ptr; scheme_extension_table->scheme_gc_ptr_ok = scheme_gc_ptr_ok; scheme_extension_table->scheme_collect_garbage = scheme_collect_garbage; + scheme_extension_table->scheme_disable_garbage_collection = scheme_disable_garbage_collection; #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL scheme_extension_table->GC_variable_stack = GC_variable_stack; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 5cb3f87440..6c21e11dd0 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -247,6 +247,7 @@ #define scheme_dont_gc_ptr (scheme_extension_table->scheme_dont_gc_ptr) #define scheme_gc_ptr_ok (scheme_extension_table->scheme_gc_ptr_ok) #define scheme_collect_garbage (scheme_extension_table->scheme_collect_garbage) +#define scheme_disable_garbage_collection (scheme_extension_table->scheme_disable_garbage_collection) #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL #define GC_variable_stack (scheme_extension_table->GC_variable_stack) diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 0d52231b11..a9e7d7b6ee 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -7616,6 +7616,23 @@ static void done_with_GC() #ifdef MZ_USE_FUTURES scheme_future_continue_after_gc(); #endif + +#ifndef MZ_PRECISE_GC + { + Scheme_Logger *logger = scheme_get_main_logger(); + if (logger) { + char buf[64]; + intptr_t buflen; + + sprintf(buf, + "GC in %" PRIdPTR " msec", + end_this_gc_time - start_this_gc_time); + buflen = strlen(buf); + + scheme_log_message(logger, SCHEME_LOG_DEBUG, buf, buflen, NULL); + } + } +#endif } #ifdef MZ_PRECISE_GC