add PLTDISABLEGC environment variable

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?]{
 

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

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.

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)

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)
 {

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;

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

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

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

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

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

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

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;

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

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;

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;

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)

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