Adding minor collections to collect-garbage

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).}

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

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

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

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

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

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

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

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

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

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;
 }