instrumenting alloc times and sizes

gc.c

@@ -61,6 +61,26 @@ void sexp_debug_heap_stats (sexp_heap heap) {
 }
 #endif
 
+#if SEXP_USE_TRACK_ALLOC_TIMES
+void sexp_debug_alloc_times(sexp ctx) {
+  double mean = (double) sexp_context_alloc_usecs(ctx) / sexp_context_alloc_count(ctx);
+  double var = (double) sexp_context_alloc_usecs_sq(ctx) / sexp_context_alloc_count(ctx) - mean*mean;
+  fprintf(stderr, SEXP_BANNER("alloc: mean: %0.3lfμs var: %0.3lfμs (%ld times)"), mean, var, sexp_context_alloc_count(ctx));
+}
+#endif
+
+#if SEXP_USE_TRACK_ALLOC_SIZES
+void sexp_debug_alloc_sizes(sexp ctx) {
+  int i;
+  fprintf(stderr, "alloc size histogram: {");
+  for (i=0; i<SEXP_ALLOC_HISTOGRAM_BUCKETS; ++i) {
+    if ((i+1)*sexp_heap_align(1)<100 || sexp_context_alloc_histogram(ctx)[i]>0)
+      fprintf(stderr, "  %ld:%ld", (i+1)*sexp_heap_align(1), sexp_context_alloc_histogram(ctx)[i]);
+  }
+  fprintf(stderr, "}\n");
+}
+#endif
+
 void sexp_free_heap (sexp_heap heap) {
 #if SEXP_USE_MMAP_GC
   munmap(heap, sexp_heap_pad_size(heap->size));
@@ -601,7 +621,19 @@ void* sexp_alloc (sexp ctx, size_t size) {
   void *res;
   size_t max_freed, sum_freed, total_size;
   sexp_heap h = sexp_context_heap(ctx);
+#if SEXP_USE_TRACK_ALLOC_SIZES
+  size_t size_bucket;
+#endif
+#if SEXP_USE_TRACK_ALLOC_TIMES
+  sexp_uint_t alloc_time;
+  struct timeval start, end;
+  gettimeofday(&start, NULL);
+#endif
   size = sexp_heap_align(size) + SEXP_GC_PAD;
+#if SEXP_USE_TRACK_ALLOC_SIZES
+  size_bucket = (size - SEXP_GC_PAD) / sexp_heap_align(1);
+  ++sexp_context_alloc_histogram(ctx)[size_bucket >= SEXP_ALLOC_HISTOGRAM_BUCKETS ? SEXP_ALLOC_HISTOGRAM_BUCKETS-1 : size_bucket];
+#endif
   res = sexp_try_alloc(ctx, size);
   if (! res) {
     max_freed = sexp_unbox_fixnum(sexp_gc(ctx, &sum_freed));
@@ -617,6 +649,13 @@ void* sexp_alloc (sexp ctx, size_t size) {
       sexp_debug_printf("ran out of memory allocating %lu bytes => %p", size, res);
     }
   }
+#if SEXP_USE_TRACK_ALLOC_TIMES
+  gettimeofday(&end, NULL);
+  alloc_time = 1000000*(end.tv_sec - start.tv_sec) + (end.tv_usec - start.tv_usec);
+  sexp_context_alloc_count(ctx) += 1;
+  sexp_context_alloc_usecs(ctx) += alloc_time;
+  sexp_context_alloc_usecs_sq(ctx) += alloc_time*alloc_time;
+#endif
   return res;
 }
 

include/chibi/features.h

@@ -469,6 +469,18 @@
 #define SEXP_USE_TRACK_ALLOC_BACKTRACE SEXP_USE_TRACK_ALLOC_SOURCE
 #endif
 
+#ifndef SEXP_USE_TRACK_ALLOC_TIMES
+#define SEXP_USE_TRACK_ALLOC_TIMES 0
+#endif
+
+#ifndef SEXP_USE_TRACK_ALLOC_SIZES
+#define SEXP_USE_TRACK_ALLOC_SIZES 0
+#endif
+
+#ifndef SEXP_ALLOC_HISTOGRAM_BUCKETS
+#define SEXP_ALLOC_HISTOGRAM_BUCKETS 32
+#endif
+
 #ifndef SEXP_BACKTRACE_SIZE
 #define SEXP_BACKTRACE_SIZE 3
 #endif

include/chibi/sexp.h

@@ -548,6 +548,13 @@ struct sexp_struct {
       sexp_uint_t last_fp;
 #if SEXP_USE_TIME_GC
       sexp_uint_t gc_count, gc_usecs;
+#endif
+#if SEXP_USE_TRACK_ALLOC_TIMES
+      sexp_uint_t alloc_count, alloc_usecs;
+      double alloc_usecs_sq;
+#endif
+#if SEXP_USE_TRACK_ALLOC_SIZES
+      sexp_uint_t alloc_histogram[SEXP_ALLOC_HISTOGRAM_BUCKETS];
 #endif
       sexp stack, env, parent, child,
         globals, dk, params, proc, name, specific, event, result;
@@ -1311,6 +1318,14 @@ enum sexp_uniform_vector_type {
 #define sexp_context_gc_count(x) 0
 #define sexp_context_gc_usecs(x) 0
 #endif
+#if SEXP_USE_TRACK_ALLOC_TIMES
+#define sexp_context_alloc_count(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_count))
+#define sexp_context_alloc_usecs(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_usecs))
+#define sexp_context_alloc_usecs_sq(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_usecs_sq))
+#endif
+#if SEXP_USE_TRACK_ALLOC_SIZES
+#define sexp_context_alloc_histogram(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_histogram))
+#endif
 #define sexp_context_refuel(x)   (sexp_field(x, context, SEXP_CONTEXT, refuel))
 #define sexp_context_ip(x)       (sexp_field(x, context, SEXP_CONTEXT, ip))
 #define sexp_context_proc(x)     (sexp_field(x, context, SEXP_CONTEXT, proc))
@@ -1765,6 +1780,8 @@ SEXP_API sexp sexp_finalize (sexp ctx);
 #else
 SEXP_API void sexp_free_heap (sexp_heap heap);
 SEXP_API void sexp_debug_heap_stats (sexp_heap heap);
+SEXP_API void sexp_debug_alloc_times(sexp ctx);
+SEXP_API void sexp_debug_alloc_sizes(sexp ctx);
 SEXP_API sexp sexp_destroy_context (sexp ctx);
 SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
 #endif

sexp.c

@@ -657,6 +657,11 @@ sexp sexp_make_context (sexp ctx, size_t size, size_t max_size) {
 #if SEXP_USE_TIME_GC
   sexp_context_gc_count(res) = 0;
   sexp_context_gc_usecs(res) = 0;
+#endif
+#if SEXP_USE_TRACK_ALLOC_TIMES
+  sexp_context_alloc_count(res) = 0;
+  sexp_context_alloc_usecs(res) = 0;
+  sexp_context_alloc_usecs_sq(res) = 0;
 #endif
   sexp_context_tracep(res) = 0;
   sexp_context_timeoutp(res) = 0;
@@ -687,6 +692,12 @@ sexp sexp_destroy_context (sexp ctx) {
     heap = sexp_context_heap(ctx);
 #if SEXP_USE_DEBUG_GC
     sexp_debug_heap_stats(heap);
+#endif
+#if SEXP_USE_TRACK_ALLOC_TIMES
+    sexp_debug_alloc_times(ctx);
+#endif
+#if SEXP_USE_TRACK_ALLOC_SIZES
+    sexp_debug_alloc_sizes(ctx);
 #endif
     sexp_markedp(ctx) = 1;
     sexp_markedp(sexp_context_globals(ctx)) = 1;