improve allocation reports, especially in backtrace mode

Track total bytes allocated for various tags and categories
in backtrace mode, and improve structure reporting to include
byte counts.

Strip away a more ad-hoc counting that was added recently.

racket/src/racket/gc2/gc2_dump.h

@@ -6,7 +6,7 @@
 
 typedef char *(*GC_get_type_name_proc)(short t);
 typedef void (*GC_for_each_found_proc)(void *p);
-typedef void (*GC_for_each_struct_proc)(void *p);
+typedef void (*GC_for_each_struct_proc)(void *p, int sz);
 
 typedef void (*GC_print_tagged_value_proc)(const char *prefix, 
 					   void *v, uintptr_t diff, int max_w,
@@ -38,4 +38,8 @@ GC2_EXTERN int GC_is_tagged(void *p);
 GC2_EXTERN int GC_is_tagged_start(void *p);
 GC2_EXTERN void *GC_next_tagged_start(void *p);
 
+typedef void (*GC_allocated_object_callback_proc)(void *, intptr_t size, int tagged, int atomic);
+
+GC2_EXTERN void GC_set_allocated_object_callback(GC_allocated_object_callback_proc proc);
+
 #endif

racket/src/racket/gc2/newgc.c

@@ -2021,6 +2021,73 @@ inline static void clean_gen_half(NewGC *gc)
   gc->gen_half.curr_alloc_page = NULL;
 }
 
+
+  
+#if MZ_GC_BACKTRACE
+static GC_allocated_object_callback_proc GC_allocated_object_callback;
+static void count_object(void *p, intptr_t size, int tagged, int atomic);
+
+GC2_EXTERN void GC_set_allocated_object_callback(GC_allocated_object_callback_proc cb)
+{
+  GC_allocated_object_callback = cb;
+}
+
+static void report_gen0_objects(NewGC *gc) {
+  if (!postmaster_and_master_gc(gc)) {
+    mpage *p;
+    int ty, i;
+
+    gen0_sync_page_size_from_globals(gc);
+    
+    for (p = gc->gen0.pages; p; p = p->next) {
+      void **start = p->addr;
+      void **end = (void**)((char *)start + p->size);
+      while (start < end) {
+        objhead *info = (objhead *)start;
+        count_object(OBJHEAD_TO_OBJPTR(info),
+                     gcWORDS_TO_BYTES(info->size),
+                     ((info->type == PAGE_TAGGED)
+                      || (info->type == PAGE_PAIR)),
+                     (info->type == PAGE_ATOMIC));
+        start += info->size;
+      }
+    }
+
+    for (p = gc->gen0.big_pages; p; p = p->next) {
+      count_object(BIG_PAGE_TO_OBJECT(p),
+                   p->size,
+                   p->page_type == PAGE_TAGGED,
+                   p->page_type == PAGE_ATOMIC);
+    }
+    
+    for (ty = 0; ty < MED_PAGE_TYPES; ty++) {
+      for (i = 0; i < NUM_MED_PAGE_SIZES; i++) {
+        for (p = gc->med_pages[ty][i]; p; p = p->next) {
+          if (p->generation == AGE_GEN_0) {
+            void **start = PPTR(NUM(p->addr) + PREFIX_SIZE);
+            void **end = PPTR(NUM(p->addr) + APAGE_SIZE - p->obj_size);
+            
+            while (start < end) {
+              objhead *info = (objhead *)start;
+              if (!info->dead) {
+                count_object(OBJHEAD_TO_OBJPTR(info),
+                             gcWORDS_TO_BYTES(info->size),
+                             ((info->type == PAGE_TAGGED)
+                              || (info->type == PAGE_PAIR)),
+                             ty == MED_PAGE_ATOMIC_INDEX);
+              }
+              start += info->size;
+            }
+          }
+        }
+      }
+    }
+  }
+}
+#else
+static void report_gen0_objects(NewGC *gc) { /* no-op */ }
+#endif
+
 /*****************************************************************************/
 /* Message allocator (intended for places)                                   */
 /*                                                                           */
@@ -5440,6 +5507,8 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
 
   TIME_INIT();
 
+  report_gen0_objects(gc);
+
   /* inform the system (if it wants us to) that we're starting collection */
   if(gc->GC_collect_start_callback)
     gc->GC_collect_start_callback();
@@ -5940,7 +6009,38 @@ const char *trace_source_kind(int kind)
 # define print_traced_objects(x, q, z, w) /* */
 #endif
 
-#define MAX_DUMP_TAG 256
+#define MAX_DUMP_TAG 512
+
+#ifdef MZ_GC_BACKTRACE
+static uintptr_t alloc_counts[MAX_DUMP_TAG], alloc_sizes[MAX_DUMP_TAG];
+static uintptr_t tagged_sizes;
+static uintptr_t non_atomic_sizes;
+static uintptr_t atomic_sizes;
+
+static void count_object(void *p, intptr_t size, int tagged, int atomic)
+{
+  if (tagged) {
+    short t = *(short *)p;
+    if ((t >= 0) && (t < MAX_DUMP_TAG)) {
+      alloc_counts[t]++;
+      alloc_sizes[t] += size;
+    }
+    tagged_sizes += size;
+  } else if (atomic)
+    atomic_sizes += size;
+  else
+    non_atomic_sizes += size;
+  
+  if (GC_allocated_object_callback)
+    GC_allocated_object_callback(p, size, tagged, atomic);
+}
+
+#define SUMMARY_SUFFIX "/BT"
+#define BT_ALLOC_COUNTS alloc_counts
+#else
+#define SUMMARY_SUFFIX ""
+#define BT_ALLOC_COUNTS counts
+#endif
 
 void GC_dump_with_traces(int flags,
                          GC_get_type_name_proc get_type_name,
@@ -5981,7 +6081,8 @@ void GC_dump_with_traces(int flags,
             sizes[tag] += info->size;
           }
           if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
-            if (for_each_struct) for_each_struct(obj_start);
+            if (for_each_struct)
+              for_each_struct(obj_start, gcWORDS_TO_BYTES(info->size));
           }
           if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) {
             register_traced_object(obj_start);
@@ -6004,7 +6105,8 @@ void GC_dump_with_traces(int flags,
         sizes[tag] += gcBYTES_TO_WORDS(page->size);
       }
       if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
-        if (for_each_struct) for_each_struct(obj_start);
+        if (for_each_struct)
+          for_each_struct(obj_start, page->size);
       }
       if (((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag))
           || ((-tag >= min_trace_for_tag) && (-tag <= max_trace_for_tag))) {
@@ -6032,7 +6134,8 @@ void GC_dump_with_traces(int flags,
                 sizes[tag] += info->size;
               }
               if ((tag == scheme_proc_struct_type) || (tag == scheme_structure_type)) {
-                if (for_each_struct) for_each_struct(obj_start);
+                if (for_each_struct)
+                  for_each_struct(obj_start, gcWORDS_TO_BYTES(info->size));
               }
               if ((tag >= min_trace_for_tag) && (tag <= max_trace_for_tag)) {
                 register_traced_object(obj_start);
@@ -6052,9 +6155,12 @@ void GC_dump_with_traces(int flags,
     num_immobiles++;
 
   if (!(flags & GC_DUMP_SUPPRESS_SUMMARY)) {
-    GCPRINT(GCOUTF, "Begin Racket3m\n");
+    GCPRINT(GCOUTF, "Begin Racket3m" SUMMARY_SUFFIX "\n");
+#ifdef MZ_GC_BACKTRACE
+    GCPRINT(GCOUTF, "                   tag  live count  live size   past count  past size\n");
+#endif
     for (i = 0; i < MAX_DUMP_TAG; i++) {
-      if (counts[i]) {
+      if (counts[i] || BT_ALLOC_COUNTS[i]) {
         char *tn, buf[256];
         if (get_type_name)
           tn = get_type_name((Type_Tag)i);
@@ -6064,11 +6170,34 @@ void GC_dump_with_traces(int flags,
           sprintf(buf, "unknown,%d", i);
           tn = buf;
         }
-        GCPRINT(GCOUTF, "  %20.20s: %10" PRIdPTR " %10" PRIdPTR "\n",
+        GCPRINT(GCOUTF, "  %20.20s: %10" PRIdPTR " %10" PRIdPTR
-                tn, counts[i], gcWORDS_TO_BYTES(sizes[i]));
+#ifdef MZ_GC_BACKTRACE
+                "   %10" PRIdPTR " %10" PRIdPTR
+#endif
+                "\n",
+                tn, counts[i], gcWORDS_TO_BYTES(sizes[i])
+#ifdef MZ_GC_BACKTRACE
+                , alloc_counts[i], alloc_sizes[i]
+#endif
+                );
       }
     }
-    GCPRINT(GCOUTF, "End Racket3m\n");
+#ifdef MZ_GC_BACKTRACE
+    {
+      intptr_t tc = 0, ts = 0, tac = 0, tas = 0;
+      for (i = 0; i < MAX_DUMP_TAG; i++) {
+        tc += counts[i];
+        ts += gcWORDS_TO_BYTES(sizes[i]);
+        tac += alloc_counts[i];
+        tas += alloc_sizes[i];
+      }
+      GCPRINT(GCOUTF, "  %20.20s: %10" PRIdPTR " %10" PRIdPTR
+              "   %10" PRIdPTR " %10" PRIdPTR
+              "\n",
+              "TOTAL", tc, ts, tac, tas);
+    }
+#endif
+    GCPRINT(GCOUTF, "End Racket3m" SUMMARY_SUFFIX "\n");
 
     GCWARN((GCOUTF, "Generation 0: %" PRIdPTR " of %" PRIdPTR " bytes used\n",
             (uintptr_t) gen0_size_in_use(gc), gc->gen0.max_size));
@@ -6076,14 +6205,28 @@ void GC_dump_with_traces(int flags,
             (uintptr_t) gen_half_size_in_use(gc)));
 
     for(i = 0; i < PAGE_TYPES; i++) {
-      uintptr_t total_use = 0, count = 0;
+      uintptr_t total_use = 0, count = 0, allocated = 0;
 
       for(page = gc->gen1_pages[i]; page; page = page->next) {
         total_use += page->size;
         count++;
+
+        if (i < PAGE_BIG) {
+          void **start = PAGE_START_VSS(page);
+          void **end = PAGE_END_VSS(page);
+
+          while(start < end) {
+            objhead *info = (objhead *)start;
+            if(!info->dead) {
+              allocated += gcWORDS_TO_BYTES(info->size);
+            }
+            start += info->size;
+          }
+        } else
+          allocated += page->size;
       }
-      GCWARN((GCOUTF, "Generation 1 [%s]: %" PRIdPTR " bytes used in %" PRIdPTR " pages\n",
+      GCWARN((GCOUTF, "Generation 1 [%s]: %" PRIdPTR " bytes used of %" PRIdPTR " in %" PRIdPTR " pages\n",
-              type_name[i], total_use, count));
+              type_name[i], allocated, total_use, count));
     }
 
     for (ty = 0; ty < MED_PAGE_TYPES; ty++) {
@@ -6120,6 +6263,13 @@ void GC_dump_with_traces(int flags,
             gc->used_pages * APAGE_SIZE,
             mmu_memory_allocated(gc->mmu) - (gc->used_pages * APAGE_SIZE)));
     GCWARN((GCOUTF,"Phantom bytes: %" PRIdPTR "\n", (gc->phantom_count + gc->gen0_phantom_count)));
+    
+    GCWARN((GCOUTF,"Past allocated memory: %10" PRIdPTR "\n", gc->total_memory_allocated));
+ #ifdef MZ_GC_BACKTRACE
+    GCWARN((GCOUTF,"Past allocated tagged: %10" PRIdPTR "\n", tagged_sizes));
+    GCWARN((GCOUTF,"Past allocated array:  %10" PRIdPTR "\n", non_atomic_sizes));
+    GCWARN((GCOUTF,"Past allocated atomic: %10" PRIdPTR "\n", atomic_sizes));
+#endif
     GCWARN((GCOUTF,"# of major collections: %" PRIdPTR "\n", gc->num_major_collects));
     GCWARN((GCOUTF,"# of minor collections: %" PRIdPTR "\n", gc->num_minor_collects));
     GCWARN((GCOUTF,"# of installed finalizers: %i\n", gc->num_fnls));

racket/src/racket/src/eval.c

@@ -2252,8 +2252,6 @@ scheme_case_lambda_execute(Scheme_Object *expr)
   int i, cnt;
   Scheme_Thread *p = scheme_current_thread;
 
-  DEBUG_COUNT_ALLOCATION(expr);
-
   seqin = (Scheme_Case_Lambda *)expr;
 
 #ifdef MZ_USE_JIT
@@ -2505,8 +2503,6 @@ scheme_make_closure(Scheme_Thread *p, Scheme_Object *code, int close)
   GC_CAN_IGNORE mzshort *map;
   int i;
 
-  DEBUG_COUNT_ALLOCATION(code);
-
   data = (Scheme_Lambda *)code;
 
 #ifdef MZ_USE_JIT

racket/src/racket/src/hash.c

@@ -246,8 +246,6 @@ Scheme_Hash_Table *scheme_make_hash_table(int type)
 {
   Scheme_Hash_Table *table;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
-
   table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
 
   table->size = 0;
@@ -642,8 +640,6 @@ Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht)
   Scheme_Hash_Table *table;
   Scheme_Object **ba;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_table_type));
-
   table = MALLOC_ONE_TAGGED(Scheme_Hash_Table);
   memcpy(table, ht, sizeof(Scheme_Hash_Table));
   MZ_OPT_HASH_KEY(&(table->iso)) = 0;
@@ -727,8 +723,6 @@ scheme_make_bucket_table (intptr_t size, int type)
   Scheme_Bucket_Table *table;
   size_t asize;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
-
   table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
 
   table->size = 4;
@@ -1125,8 +1119,6 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
   Scheme_Bucket_Table *table;
   size_t asize;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_bucket_table_type));
-
   table = MALLOC_ONE_TAGGED(Scheme_Bucket_Table);
   table->so.type = scheme_bucket_table_type;
   table->size = bt->size;
@@ -2570,7 +2562,6 @@ XFORM_NONGCING static Scheme_Hash_Tree *hamt_assoc(Scheme_Hash_Tree *ht, uintptr
 static Scheme_Hash_Tree *hamt_alloc(int kind, int popcount)
 /* be sure to set `bitmap` field before a GC becomes possible */
 {
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_hash_tree_type));
   return (Scheme_Hash_Tree *)scheme_malloc_small_tagged(HASH_TREE_RECORD_SIZE(kind, popcount));
 }
 

racket/src/racket/src/list.c

@@ -1050,11 +1050,9 @@ scheme_init_unsafe_hash (Scheme_Env *env)
 Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
 {
 #ifdef MZ_PRECISE_GC
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
   return GC_malloc_pair(car, cdr);
 #else
   Scheme_Object *cons;
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_pair_type));
   cons = scheme_alloc_object();
   cons->type = scheme_pair_type;
   SCHEME_CAR(cons) = car;
@@ -1795,8 +1793,6 @@ Scheme_Object *scheme_box(Scheme_Object *v)
 {
   Scheme_Object *obj;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_box_type));
-
   obj = scheme_alloc_small_object();
   obj->type = scheme_box_type;
   SCHEME_BOX_VAL(obj) = v;
@@ -3650,13 +3646,10 @@ static Scheme_Object *eqv_hash_code(int argc, Scheme_Object *argv[])
 Scheme_Object *scheme_make_weak_box(Scheme_Object *v)
 {
 #ifdef MZ_PRECISE_GC
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
   return (Scheme_Object *)GC_malloc_weak_box(v, NULL, 0, 0);
 #else
   Scheme_Small_Object *obj;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_weak_box_type));
-  
   obj = MALLOC_ONE_TAGGED_WEAK(Scheme_Small_Object);
   obj->iso.so.type = scheme_weak_box_type;
 

racket/src/racket/src/salloc.c

@@ -95,6 +95,10 @@ extern MZGC_DLLIMPORT void GC_register_late_disappearing_link(void **link, void
 extern MZGC_DLLIMPORT void GC_register_indirect_disappearing_link(void **link, void *obj);
 #endif
 
+#ifdef MZ_GC_BACKTRACE
+static void init_allocation_callback(void);
+#endif
+
 SHARED_OK static int use_registered_statics;
 
 /************************************************************************/
@@ -143,6 +147,9 @@ void scheme_set_stack_base(void *base, int no_auto_statics) XFORM_SKIP_PROC
   use_registered_statics = no_auto_statics;
 #if defined(MZ_PRECISE_GC)
   GC_report_out_of_memory = scheme_out_of_memory_abort;
+# ifdef MZ_GC_BACKTRACE
+  init_allocation_callback();
+# endif
 #endif
 }
 
@@ -1962,6 +1969,24 @@ static int record_traced_and_print_new(void *p)
 
   return record_traced(p);
 }
+
+static void record_allocated_object(void *p, intptr_t size, int tagged, int atomic)
+{
+  if (tagged) {
+    Scheme_Type t = *(Scheme_Type *)p;
+    if (SAME_TYPE(t, scheme_structure_type)
+        || SAME_TYPE(t, scheme_proc_struct_type)) {
+      Scheme_Structure *s = (Scheme_Structure *)p;
+      s->stype->total_instance_count++;
+      s->stype->total_instance_sizes += size;
+    }
+  }
+}
+
+static void init_allocation_callback() {
+  GC_set_allocated_object_callback(record_allocated_object);
+}
+
 #endif
 
 #if MZ_PRECISE_GC
@@ -1973,9 +1998,10 @@ static void increment_found_counter(void *p)
 #endif
 
 #if MZ_PRECISE_GC_TRACE
-static void count_struct_instance(void *p) {
+static void count_struct_instance(void *p, int sz) {
   Scheme_Structure *s = (Scheme_Structure *)p;
-  s->stype->instance_count++;
+  s->stype->current_instance_count++;
+  s->stype->current_instance_sizes += sz;
 }
 #endif
 
@@ -2660,9 +2686,15 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
     scheme_console_printf("Begin Struct\n");
     while (SCHEME_PAIRP(cons_accum_result)) {
       Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_CAR(cons_accum_result);
-      if (stype->instance_count) {
+      if (stype->total_instance_count) {
-        scheme_console_printf(" %32.32s: %10" PRIdPTR "\n", SCHEME_SYM_VAL(stype->name), stype->instance_count);
+        scheme_console_printf(" %32.32s: %10" PRIdPTR " %10" PRIdPTR "   %10" PRIdPTR " %10" PRIdPTR "\n",
-        stype->instance_count = 0;
+                              SCHEME_SYM_VAL(stype->name),
+                              stype->current_instance_count,
+                              stype->current_instance_sizes,
+                              stype->total_instance_count,
+                              stype->total_instance_sizes);
+        stype->current_instance_count = 0;
+        stype->current_instance_sizes = 0;
       }
       cons_accum_result = SCHEME_CDR(cons_accum_result);
     }
@@ -2771,8 +2803,6 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
   return result;
 }
 
-
-
 #ifdef MEMORY_COUNTING_ON
 
 intptr_t scheme_count_closure(Scheme_Object **o, mzshort len, Scheme_Hash_Table *ht)
@@ -3288,92 +3318,3 @@ intptr_t scheme_count_envbox(Scheme_Object *root, Scheme_Hash_Table *ht)
 }
 
 #endif
-
-/**********************************************************************/
-
-#if RECORD_ALLOCATION_COUNTS
- 
-/* Allocation profiling --- prints allocated counts (not necessarily
-   still live) after every `NUM_ALLOCS_BEFORE_REPORT` structure and
-   closure allocations. Adjust that constant to match a test program.
-   Also, run with `racket -j` so that structure allocation is not
-   inlined, and don't use places. */
-
-#define NUM_ALLOCS_BEFORE_REPORT 100000
-
-static Scheme_Hash_Table *allocs;
-static int alloc_count;
-static int reporting;
-
-#include "../gc2/my_qsort.c"
-typedef struct alloc_count_result { int pos; int count; } alloc_count_result;
-
-static int smaller_alloc_count(const void *a, const void *b) {
-  return ((alloc_count_result*)a)->count - ((alloc_count_result*)b)->count;
-}
-
-void scheme_record_allocation(Scheme_Object *tag)
-{
-  Scheme_Object *c;
-  
-  if (reporting)
-    return;
-
-  alloc_count++;
-
-  if (!allocs) {
-    REGISTER_SO(allocs);
-    reporting++;
-    allocs = scheme_make_hash_table(SCHEME_hash_ptr);
-    --reporting;
-  }
-
-  c = scheme_hash_get(allocs, tag);
-  if (!c) c = scheme_make_integer(0);
-  scheme_hash_set(allocs, tag, scheme_make_integer(SCHEME_INT_VAL(c)+1));
-    
-  if (alloc_count == NUM_ALLOCS_BEFORE_REPORT) {
-    alloc_count_result *a;
-    int count = allocs->count;
-    int k = 0;
-    int i;
-    char *s;
-
-    reporting++;
-    
-    a = MALLOC_N_ATOMIC(alloc_count_result, count);
-    printf("\n");
-    for (i = allocs->size; i--; ) {
-      if (allocs->vals[i]) {
-        a[k].pos = i;
-        a[k].count = SCHEME_INT_VAL(allocs->vals[i]);
-        k++;
-      }
-    }
-    my_qsort(a, allocs->count, sizeof(alloc_count_result), smaller_alloc_count);
-    
-    for (i = 0; i < count; i++) {
-      tag = allocs->keys[a[i].pos];
-
-      if (SCHEME_INTP(tag)) {
-        s = scheme_get_type_name(SCHEME_INT_VAL(tag));
-      } else {
-        if (SAME_TYPE(SCHEME_TYPE(tag), scheme_lambda_type)
-            && ((Scheme_Lambda *)tag)->name)
-          tag = ((Scheme_Lambda*)tag)->name;
-        else if (SAME_TYPE(SCHEME_TYPE(tag), scheme_case_lambda_sequence_type)
-                 && ((Scheme_Case_Lambda *)tag)->name)
-          tag = ((Scheme_Case_Lambda*)tag)->name;
-      
-        s = scheme_write_to_string(tag, NULL);
-      }
-      
-      printf("%d %s\n", a[i].count, s);
-    }
-    
-    alloc_count = 0;
-    --reporting;
-  }
-}
-
-#endif

racket/src/racket/src/schpriv.h

@@ -1060,7 +1060,10 @@ typedef struct Scheme_Struct_Type {
   Scheme_Object *guard;
 
 #if defined(MZ_GC_BACKTRACE) && defined(MZ_PRECISE_GC)
-  intptr_t instance_count;
+  intptr_t current_instance_count;
+  intptr_t current_instance_sizes;
+  intptr_t total_instance_count;
+  intptr_t total_instance_sizes;
 #endif
 
   struct Scheme_Struct_Type *parent_types[mzFLEX_ARRAY_DECL];
@@ -4424,18 +4427,6 @@ void scheme_count_generic(Scheme_Object *o, intptr_t *s, intptr_t *e, Scheme_Has
 #endif
 #endif
 
-/* See "salloc.c": */
-#ifndef RECORD_ALLOCATION_COUNTS
-# define RECORD_ALLOCATION_COUNTS 0
-#endif
-
-#if RECORD_ALLOCATION_COUNTS
-extern void scheme_record_allocation(Scheme_Object *key);
-# define DEBUG_COUNT_ALLOCATION(x) scheme_record_allocation(x);
-#else 
-# define DEBUG_COUNT_ALLOCATION(x) /* empty */
-#endif
-
 /*========================================================================*/
 /*                           miscellaneous                                */
 /*========================================================================*/

racket/src/racket/src/struct.c

@@ -2544,6 +2544,8 @@ static Scheme_Object **apply_guards(Scheme_Struct_Type *stype, int argc, Scheme_
   return args;
 }
 
+#define STRUCT_BYTES(c) (sizeof(Scheme_Structure) + (((c) - mzFLEX_DELTA) * sizeof(Scheme_Object *)))
+
 Scheme_Object *
 scheme_make_struct_instance(Scheme_Object *_stype, int argc, Scheme_Object **args)
 {
@@ -2554,12 +2556,9 @@ scheme_make_struct_instance(Scheme_Object *_stype, int argc, Scheme_Object **arg
 
   stype = (Scheme_Struct_Type *)_stype;
 
-  DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
-
   c = stype->num_slots;
   inst = (Scheme_Structure *)
-    scheme_malloc_tagged(sizeof(Scheme_Structure) 
+    scheme_malloc_tagged(STRUCT_BYTES(c));
-			 + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   
   inst->so.type = (stype->proc_attr ? scheme_proc_struct_type : scheme_structure_type);
   inst->stype = stype;
@@ -2604,12 +2603,9 @@ Scheme_Object *scheme_make_blank_prefab_struct_instance(Scheme_Struct_Type *styp
   Scheme_Structure *inst;
   int c;
 
-  DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
-
   c = stype->num_slots;
   inst = (Scheme_Structure *)
-    scheme_malloc_tagged(sizeof(Scheme_Structure) 
+    scheme_malloc_tagged(STRUCT_BYTES(c));
-			 + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   
   inst->so.type = scheme_structure_type;
   inst->stype = stype;
@@ -2623,8 +2619,7 @@ Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *prefab_key,
   Scheme_Serialized_Structure *inst;
 
   inst = (Scheme_Serialized_Structure *)
-    scheme_malloc_tagged(sizeof(Scheme_Serialized_Structure) 
+    scheme_malloc_tagged(STRUCT_BYTES(num_slots));
-			 + ((num_slots - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   
   inst->so.type = scheme_serialized_structure_type;
   inst->num_slots = num_slots;
@@ -2640,12 +2635,9 @@ Scheme_Object *scheme_make_prefab_struct_instance(Scheme_Struct_Type *stype,
   Scheme_Structure *inst;
   int i, c;
 
-  DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
-
   c = stype->num_slots;
   inst = (Scheme_Structure *)
-    scheme_malloc_tagged(sizeof(Scheme_Structure) 
+    scheme_malloc_tagged(STRUCT_BYTES(c));
-			 + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   
   inst->so.type = scheme_structure_type;
   inst->stype = stype;
@@ -2670,8 +2662,7 @@ Scheme_Object *scheme_clone_prefab_struct_instance(Scheme_Structure *s)
     chaperone = NULL;
 
   c = s->stype->num_slots;
-  sz = (sizeof(Scheme_Structure) 
+  sz = STRUCT_BYTES(c);
-        + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   inst = (Scheme_Structure *)scheme_malloc_tagged(sz);
   memcpy(inst, s, sz);
 
@@ -2699,12 +2690,9 @@ make_simple_struct_instance(int argc, Scheme_Object **args, Scheme_Object *prim)
   Scheme_Struct_Type *stype = (Scheme_Struct_Type *)SCHEME_PRIM_CLOSURE_ELS(prim)[0];
   int i, c;
 
-  DEBUG_COUNT_ALLOCATION((Scheme_Object *)stype);
-
   c = stype->num_slots;
   inst = (Scheme_Structure *)
-    scheme_malloc_tagged(sizeof(Scheme_Structure) 
+    scheme_malloc_tagged(STRUCT_BYTES(c));
-			 + ((c - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
   
   inst->so.type = scheme_structure_type;
   inst->stype = stype;

racket/src/racket/src/syntax.c

@@ -465,8 +465,6 @@ Scheme_Object *scheme_make_stx(Scheme_Object *val,
 {
   Scheme_Stx *stx;
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_stx_type));
-
   stx = MALLOC_ONE_TAGGED(Scheme_Stx);
   stx->iso.so.type = scheme_stx_type;
   STX_KEY(stx) = HAS_SUBSTX(val) ? STX_SUBSTX_FLAG : 0;

racket/src/racket/src/type.c

@@ -328,7 +328,25 @@ scheme_init_type ()
   set_name(scheme_environment_variables_type, "<environment-variables>");
 
 #ifdef MZ_GC_BACKTRACE
+  set_name(scheme_rt_runstack, "<runstack>");
   set_name(scheme_rt_meta_cont, "<meta-continuation>");
+  set_name(scheme_rt_weak_array, "<weak-array>");
+  set_name(scheme_syntax_property_preserve_type, "<syntax-property-preserve-wrapper>");
+  set_name(scheme_rt_resolve_info, "<compile-resolve-frame>");
+  set_name(scheme_rt_unresolve_info, "<compile-unresolve-frame>");
+  set_name(scheme_rt_optimize_info, "<compile-optimize-frame>");
+  set_name(scheme_rt_ir_lambda_info, "<compile-lambda-info>");
+  set_name(scheme_deferred_expr_type, "<compile-letrec-check-deferred>");
+  set_name(scheme_will_be_lambda_type, "<compile-letrec-check-lambda>");
+  set_name(scheme_rt_indexed_string, "<string-port-data>");
+  set_name(scheme_rt_srcloc, "<srcloc>");
+  set_name(scheme_rt_comp_prefix, "<compile-prefix>");
+  set_name(scheme_rt_native_code, "<native-code>");
+  set_name(scheme_rt_native_code_plus_case, "<native-code+case>");
+  set_name(scheme_rt_sfs_info, "<compile-safe-for-space-frame>");
+  set_name(scheme_rt_letrec_check_frame, "<compile-letrec-check-frame>");
+  set_name(scheme_rt_module_exports, "<module-export-set>");
+  set_name(scheme_rt_export_info, "<module-export-info>");
 #endif
 }
 

racket/src/racket/src/vector.c

@@ -287,8 +287,6 @@ scheme_make_vector (intptr_t size, Scheme_Object *fill)
     scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec);
   }
 
-  DEBUG_COUNT_ALLOCATION(scheme_make_integer(scheme_vector_type));
-
   if (size < 1024) {
     vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
   } else {