track cumulative allocation

Extend `current-memory-use` to accept a 'cumulative flag.

pkgs/racket-doc/scribblings/reference/memory.scrbl

@@ -350,24 +350,42 @@ garbage-collection mode, depending on @racket[request]:
          #:changed "6.3.0.2" @elem{Added @racket['incremental] mode.}]}
 
 
-@defproc[(current-memory-use [cust custodian? #f]) exact-nonnegative-integer?]{
+@defproc[(current-memory-use [mode (or/c #f 'cumulative custodian?) #f])
+         exact-nonnegative-integer?]{
 
-Returns an estimate of the number of bytes of memory occupied by
-reachable data from @racket[cust].  This estimate is calculated by the
-last garbage collection, and can be 0 if none occurred (or if none occurred
-since the given custodian was created).  The @racket[current-memory-use]
-function does @italic{not} perform a collection by itself; doing one
-before the call will generally decrease the result (or increase it from
-0 if no collections happened yet).
+Returns information about memory use:
 
-If @racket[cust] is not provided, the estimate is a total reachable from
-any custodians.
+@itemlist[
 
-When Racket is compiled without support for memory accounting, the
-estimate is the same (i.e., all memory) for any individual custodian;
-see also @racket[custodian-memory-accounting-available?].
+ @item{If @racket[mode] is @racket[#f] (the default), the result is an
+       estimate of the number of bytes reachable from any custodian.}
+
+ @item{If @racket[mode] is @racket['cumulative], returns an estimate
+       of the total number of bytes allocated since start up,
+       including bytes that have since been reclaimed by garbage
+       collection.}
+
+ @item{If @racket[mode] is a custodian, returns an estimate of the
+       number of bytes of memory occupied by reachable data from
+       @racket[mode]. This estimate is calculated by the last garbage
+       collection, and can be 0 if none occurred (or if none occurred
+       since the given custodian was created). The
+       @racket[current-memory-use] function does @italic{not} perform
+       a collection by itself; doing one before the call will
+       generally decrease the result (or increase it from 0 if no
+       collections happened yet).
+
+       When Racket is compiled without support for memory accounting,
+       the estimate is the same as when @racket[mode] is @racket[#f]
+       (i.e., all memory) for any individual custodian. See also
+       @racket[custodian-memory-accounting-available?].}
+
+]
+
+See also @racket[vector-set-performance-stats!].
+
+@history[#:changed "6.6.0.3" @elem{Added @racket['cumulative] mode.}]}
 
-See also @racket[vector-set-performance-stats!].}
 
 @defproc[(dump-memory-stats [v any/c] ...) any]{
 

racket/src/racket/gc2/gc2.h

@@ -145,6 +145,11 @@ GC2_EXTERN intptr_t GC_get_memory_use(void *c);
    Returns the number of currently-allocated bytes (speficilly for
    custodian c, as much as the GC's accounting makes possible). */
 
+GC2_EXTERN intptr_t GC_get_memory_ever_allocated();
+/*
+   Returns the number of total number of allocated bytes, including
+   bytes that have since been reclaimed. */
+
 GC2_EXTERN int GC_accouting_enabled();
 /* 
    Reports whether memory accounting is enabled. */

racket/src/racket/gc2/newgc.c

@@ -41,6 +41,9 @@
 /* Avoid incremental GC if the heap seems to be getting too fragmented: */
 #define HIGH_FRAGMENTATION_RATIO 2
 
+/* Initial and minimum value to treat as previous use after a full GC: */
+#define INITIAL_FULL_MEMORY_USE (20 * 1024 * 1024)
+
 /* Whether to use a little aging, moving gen-0 objects to a
    gen-1/2 space:  */
 #define AGE_GEN_0_TO_GEN_HALF(gc) ((gc)->started_incremental)
@@ -745,7 +748,7 @@ static void NewGC_initialize(NewGC *newgc, NewGC *inheritgc, NewGC *parentgc) {
   newgc->mmu = mmu_create(newgc);
   
   newgc->generations_available = 1;
-  newgc->last_full_mem_use = (20 * 1024 * 1024);
+  newgc->last_full_mem_use = INITIAL_FULL_MEMORY_USE;
   newgc->new_btc_mark = 1;
 
   newgc->place_memory_limit = (uintptr_t)(intptr_t)-1;
@@ -973,6 +976,16 @@ intptr_t GC_get_memory_use(void *o)
   return (intptr_t)amt;
 }
 
+intptr_t GC_get_memory_ever_allocated()
+{
+  NewGC *gc = GC_get_GC();
+  uintptr_t amt;
+  
+  amt = add_no_overflow(gen0_size_in_use(gc), gc->total_memory_allocated);
+  
+  return (intptr_t)amt;
+}
+
 /*****************************************************************************/
 /* Write barrier                                                             */
 /*                                                                           */
@@ -5314,6 +5327,8 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
   old_gen0    = gen0_size_in_use(gc) + gc->gen0_phantom_count;
   old_mem_allocated = mmu_memory_allocated(gc->mmu) + gc->phantom_count + gc->gen0_phantom_count;
 
+  gc->total_memory_allocated += old_gen0;
+
   TIME_DECLS();
 
   dump_page_map(gc, "pre");
@@ -5334,7 +5349,9 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
                     This approach makes total memory use roughly a constant
                     fraction of the actual use by live data: */
                  || (gc->memory_in_use > (FULL_COLLECTION_SIZE_RATIO
-                                          * gc->last_full_mem_use
+                                          * ((gc->last_full_mem_use < INITIAL_FULL_MEMORY_USE)
+                                             ? INITIAL_FULL_MEMORY_USE
+                                             : gc->last_full_mem_use)
                                           * (gc->incremental_requested
                                              ? INCREMENTAL_EXTRA_SIZE_RATIO
                                              : 1)))

racket/src/racket/gc2/newgc.h

@@ -312,6 +312,8 @@ typedef struct NewGC {
   uintptr_t minor_old_skipped;
   uintptr_t modified_unprotects;
   
+  uintptr_t total_memory_allocated; /* doesn't include current gen0 */
+  
   /* THREAD_LOCAL variables that need to be saved off */
   void         *saved_GC_variable_stack;
   uintptr_t saved_GC_gen0_alloc_page_ptr;

racket/src/racket/sgc/sgc.c

@@ -799,7 +799,7 @@ static intptr_t mem_use, mem_limit = FIRST_GC_LIMIT;
 int GC_free_space_divisor = 4;
 #endif
 
-static intptr_t mem_real_use, mem_uncollectable_use;
+static intptr_t mem_real_use, mem_uncollectable_use, mem_cumulative_use;
 
 static intptr_t sector_mem_use, sector_admin_mem_use, sector_free_mem_use;
 static intptr_t manage_mem_use, manage_real_mem_use;
@@ -2230,11 +2230,14 @@ void GC_dump(void)
   FPRINTF(STDERR, "End Map\n");
 }
 
-long GC_get_memory_use()
+size_t GC_get_memory_use()
 {
-  /* returns a `long' instead of `intptr_t' for compatibility
-     with the Boehm GC */
-  return (long)mem_real_use;
+  return (size_t)mem_real_use;
+}
+
+size_t GC_get_total_bytes()
+{
+  return (size_t)mem_cumulative_use;
 }
 
 void GC_end_stubborn_change(void *p)
@@ -2504,6 +2507,7 @@ static void *do_malloc(SET_NO_BACKINFO
     else
       mem_use += size;
     mem_real_use += (size + sizeof(MemoryChunk));
+    mem_cumulative_use += (size + sizeof(MemoryChunk));
     num_chunks++;
 
     if (!low_plausible || (c->start < low_plausible))
@@ -2642,6 +2646,7 @@ static void *do_malloc(SET_NO_BACKINFO
     high_plausible = block->end;	
 
   mem_real_use += SECTOR_SEGMENT_SIZE;
+  mem_cumulative_use += SECTOR_SEGMENT_SIZE;
 
  block_top:
 
@@ -2950,6 +2955,7 @@ static void register_finalizer(void *p, void (*f)(void *p, void *data),
       if (!fn) {
 	fn = (Finalizer *)malloc_managed(sizeof(Finalizer));
 	mem_real_use += sizeof(Finalizer);
+	mem_cumulative_use += sizeof(Finalizer);
 	GC_fo_entries++;
       }
 

racket/src/racket/sgc/sgc.h

@@ -35,7 +35,8 @@ SGC_EXTERN void *GC_base(void *);
 
 SGC_EXTERN void GC_dump(void);
 
-SGC_EXTERN long GC_get_memory_use();
+SGC_EXTERN size_t GC_get_memory_use();
+SGC_EXTERN size_t GC_get_total_bytes();
 
 SGC_EXTERN void GC_end_stubborn_change(void *);
 

racket/src/racket/src/thread.c

@@ -244,6 +244,7 @@ THREAD_LOCAL_DECL(struct Scheme_GC_Pre_Post_Callback_Desc *gc_prepost_callback_d
 ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete_symbol, *exists_symbol;
 ROSYM static Scheme_Object *client_symbol, *server_symbol;
 ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol;
+ROSYM static Scheme_Object *cumulative_symbol;
 
 ROSYM static Scheme_Object *initial_compiled_file_check_symbol;
 
@@ -528,6 +529,9 @@ void scheme_init_thread(Scheme_Env *env)
   minor_symbol = scheme_intern_symbol("minor");
   incremental_symbol  = scheme_intern_symbol("incremental");
 
+  REGISTER_SO(cumulative_symbol);
+  cumulative_symbol = scheme_intern_symbol("cumulative");
+
   GLOBAL_PRIM_W_ARITY("dump-memory-stats"            , scheme_dump_gc_stats, 0, -1, env);
   GLOBAL_PRIM_W_ARITY("vector-set-performance-stats!", current_stats       , 1, 2, env);
 
@@ -734,6 +738,7 @@ static Scheme_Object *collect_garbage(int argc, Scheme_Object *argv[])
 static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
 {
   Scheme_Object *arg = NULL;
+  int cumulative = 0;
   uintptr_t retval = 0;
 
   if (argc) {
@@ -741,19 +746,30 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
       arg = args[0];
     } else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
       arg = args[0];
+    } else if (SAME_OBJ(args[0], cumulative_symbol)) {
+      cumulative = 1;
+      arg = NULL;
     } else {
       scheme_wrong_contract("current-memory-use", 
-                            "(or/c custodian? #f)", 
+                            "(or/c custodian? 'cumulative #f)", 
                             0, argc, args);
     }
   }
 
+  if (cumulative) {
 #ifdef MZ_PRECISE_GC
-  retval = GC_get_memory_use(arg);
+    retval = GC_get_memory_ever_allocated();
 #else
-  scheme_unused_object(arg);
-  retval = GC_get_memory_use();
+    retval = GC_get_total_bytes();
 #endif
+  } else {
+#ifdef MZ_PRECISE_GC
+    retval = GC_get_memory_use(arg);
+#else
+    scheme_unused_object(arg);
+    retval = GC_get_memory_use();
+#endif
+  }
   
   return scheme_make_integer_value_from_unsigned(retval);
 }