From 2f22f86c0af568aa360460c694f815c141855e54 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 30 Jul 2015 11:07:32 -0600 Subject: [PATCH] Adding minor collections to collect-garbage --- pkgs/racket-doc/scribblings/reference/memory.scrbl | 5 ++++- racket/src/racket/include/mzwin.def | 1 + racket/src/racket/include/mzwin3m.def | 1 + racket/src/racket/include/racket.exp | 1 + racket/src/racket/include/racket3m.exp | 1 + racket/src/racket/src/salloc.c | 8 ++++++++ racket/src/racket/src/schemef.h | 1 + racket/src/racket/src/schemex.h | 1 + racket/src/racket/src/schemex.inc | 1 + racket/src/racket/src/schemexm.h | 1 + racket/src/racket/src/thread.c | 10 +++++++--- 11 files changed, 27 insertions(+), 4 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/memory.scrbl b/pkgs/racket-doc/scribblings/reference/memory.scrbl index 494c27dc3c..89e1a93b7d 100644 --- a/pkgs/racket-doc/scribblings/reference/memory.scrbl +++ b/pkgs/racket-doc/scribblings/reference/memory.scrbl @@ -286,13 +286,16 @@ collection mode, the text has the format ]} -@defproc[(collect-garbage) void?]{ +@defproc[(collect-garbage [minor? any/c #f]) void?]{ 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. +If @racket[minor?] is not false, then a minor collection is +run. Otherwise, a major collection is run. + 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 (unless garbage collection is disabled).} diff --git a/racket/src/racket/include/mzwin.def b/racket/src/racket/include/mzwin.def index 753f959fa1..f76f16ac0f 100644 --- a/racket/src/racket/include/mzwin.def +++ b/racket/src/racket/include/mzwin.def @@ -224,6 +224,7 @@ EXPORTS scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage + scheme_collect_garbage_minor scheme_enable_garbage_collection scheme_malloc_immobile_box scheme_free_immobile_box diff --git a/racket/src/racket/include/mzwin3m.def b/racket/src/racket/include/mzwin3m.def index 39f7185625..eff2ac2b08 100644 --- a/racket/src/racket/include/mzwin3m.def +++ b/racket/src/racket/include/mzwin3m.def @@ -233,6 +233,7 @@ EXPORTS scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage + scheme_collect_garbage_minor scheme_enable_garbage_collection GC_variable_stack GC_register_traversers diff --git a/racket/src/racket/include/racket.exp b/racket/src/racket/include/racket.exp index 49957bbc49..831814d7b4 100644 --- a/racket/src/racket/include/racket.exp +++ b/racket/src/racket/include/racket.exp @@ -235,6 +235,7 @@ scheme_remove_all_finalization scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage +scheme_collect_garbage_minor scheme_enable_garbage_collection GC_register_traversers GC_resolve diff --git a/racket/src/racket/include/racket3m.exp b/racket/src/racket/include/racket3m.exp index c7f99578d4..6a2642d1d8 100644 --- a/racket/src/racket/include/racket3m.exp +++ b/racket/src/racket/include/racket3m.exp @@ -240,6 +240,7 @@ scheme_remove_all_finalization scheme_dont_gc_ptr scheme_gc_ptr_ok scheme_collect_garbage +scheme_collect_garbage_minor scheme_enable_garbage_collection GC_variable_stack GC_register_traversers diff --git a/racket/src/racket/src/salloc.c b/racket/src/racket/src/salloc.c index 38567fabd8..f57ff8487d 100644 --- a/racket/src/racket/src/salloc.c +++ b/racket/src/racket/src/salloc.c @@ -1633,6 +1633,14 @@ void scheme_collect_garbage(void) GC_gcollect(); } +void scheme_collect_garbage_minor(void) +{ +#ifdef MZ_PRECISE_GC + GC_gcollect_minor(); +#else +#endif +} + void scheme_enable_garbage_collection(int on) { #ifdef MZ_PRECISE_GC diff --git a/racket/src/racket/src/schemef.h b/racket/src/racket/src/schemef.h index 6dd4307695..704f18ba8b 100644 --- a/racket/src/racket/src/schemef.h +++ b/racket/src/racket/src/schemef.h @@ -463,6 +463,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_collect_garbage_minor(void); MZ_EXTERN void scheme_enable_garbage_collection(int on); #ifdef MZ_PRECISE_GC diff --git a/racket/src/racket/src/schemex.h b/racket/src/racket/src/schemex.h index 1592de93ce..2c2384f1e7 100644 --- a/racket/src/racket/src/schemex.h +++ b/racket/src/racket/src/schemex.h @@ -362,6 +362,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_collect_garbage_minor)(void); void (*scheme_enable_garbage_collection)(int on); #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL diff --git a/racket/src/racket/src/schemex.inc b/racket/src/racket/src/schemex.inc index 505d5026a6..1eb59eaa8f 100644 --- a/racket/src/racket/src/schemex.inc +++ b/racket/src/racket/src/schemex.inc @@ -262,6 +262,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_collect_garbage_minor = scheme_collect_garbage_minor; scheme_extension_table->scheme_enable_garbage_collection = scheme_enable_garbage_collection; #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL diff --git a/racket/src/racket/src/schemexm.h b/racket/src/racket/src/schemexm.h index 47c0fc3096..cfd1bfdcf0 100644 --- a/racket/src/racket/src/schemexm.h +++ b/racket/src/racket/src/schemexm.h @@ -262,6 +262,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_collect_garbage_minor (scheme_extension_table->scheme_collect_garbage_minor) #define scheme_enable_garbage_collection (scheme_extension_table->scheme_enable_garbage_collection) #ifdef MZ_PRECISE_GC # ifndef USE_THREAD_LOCAL diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 8687a04365..74934e86a3 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -599,7 +599,7 @@ void scheme_init_thread(Scheme_Env *env) scheme_add_evt_through_sema(scheme_will_executor_type, will_executor_sema, NULL); - GLOBAL_PRIM_W_ARITY("collect-garbage" , collect_garbage , 0, 0, env); + GLOBAL_PRIM_W_ARITY("collect-garbage" , collect_garbage , 0, 1, env); GLOBAL_PRIM_W_ARITY("current-memory-use" , current_memory_use , 0, 1, env); GLOBAL_PRIM_W_ARITY("custodian-require-memory" , custodian_require_mem, 3, 3, env); @@ -710,9 +710,13 @@ void scheme_init_paramz(Scheme_Env *env) scheme_protect_primitive_provide(newenv, NULL); } -static Scheme_Object *collect_garbage(int c, Scheme_Object *p[]) +static Scheme_Object *collect_garbage(int argc, Scheme_Object *argv[]) { - scheme_collect_garbage(); + if (argc == 1 && !SCHEME_FALSEP(argv[0])) { + scheme_collect_garbage_minor(); + } else { + scheme_collect_garbage(); + } return scheme_void; }