adding optional tracking of gc time

benchmarks/gabriel/chibi-prelude.scm

@@ -1,5 +1,5 @@
 
-(import (chibi time) (scheme cxr) (srfi 33) (srfi 39))
+(import (chibi ast) (chibi time) (scheme cxr) (srfi 33) (srfi 39))
 
 (define (timeval->milliseconds tv)
   (quotient (+ (* 1000000 (timeval-seconds tv)) (timeval-microseconds tv))
@@ -9,8 +9,11 @@
   (call-with-output-string
     (lambda (out)
       (let* ((start (car (get-time-of-day)))
+             (gc-start (gc-usecs))
              (result (parameterize ((current-output-port out)) (thunk)))
              (end (car (get-time-of-day)))
+             (gc-end (gc-usecs))
+             (gc-msecs (quotient (- gc-end gc-start) 1000))
              (msecs (- (timeval->milliseconds end)
                        (timeval->milliseconds start))))
         (display "user: ")
@@ -18,7 +21,8 @@
         (display " system: 0")
         (display " real: ")
         (display msecs)
-        (display " gc: 0")
+        (display " gc: ")
+        (display gc-msecs)
         (newline)
         (display "result: ")
         (write result)

gc.c

@@ -6,6 +6,10 @@
 
 #include "chibi/sexp.h"
 
+#if SEXP_USE_TIME_GC
+#include <sys/resource.h>
+#endif
+
 #if SEXP_USE_MMAP_GC
 #include <sys/mman.h>
 #endif
@@ -462,7 +466,8 @@ void sexp_mark_global_symbols(sexp ctx) {
 
 sexp sexp_gc (sexp ctx, size_t *sum_freed) {
   sexp res, finalized SEXP_NO_WARN_UNUSED;
-#if SEXP_USE_DEBUG_GC
+#if SEXP_USE_TIME_GC
+  sexp_uint_t gc_usecs;
   struct rusage start, end;
   getrusage(RUSAGE_SELF, &start);
   sexp_debug_printf("%p (heap: %p size: %lu)", ctx, sexp_context_heap(ctx),
@@ -474,13 +479,14 @@ sexp sexp_gc (sexp ctx, size_t *sum_freed) {
   sexp_reset_weak_references(ctx);
   finalized = sexp_finalize(ctx);
   res = sexp_sweep(ctx, sum_freed);
-#if SEXP_USE_DEBUG_GC
+#if SEXP_USE_TIME_GC
   getrusage(RUSAGE_SELF, &end);
+  gc_usecs = (end.ru_utime.tv_sec - start.ru_utime.tv_sec) * 1000000 +
+    end.ru_utime.tv_usec - start.ru_utime.tv_usec;
+  sexp_context_gc_usecs(ctx) += gc_usecs;
   sexp_debug_printf("%p (freed: %lu max_freed: %lu finalized: %lu time: %luus)",
                     ctx, (sum_freed ? *sum_freed : 0), sexp_unbox_fixnum(res),
-                    sexp_unbox_fixnum(finalized),
+                    sexp_unbox_fixnum(finalized), gc_usecs);
-                    (end.ru_utime.tv_sec - start.ru_utime.tv_sec) * 1000000 +
-                    end.ru_utime.tv_usec - start.ru_utime.tv_usec);
 #endif
   return res;
 }

include/chibi/features.h

@@ -105,6 +105,9 @@
 /* uncomment this to add very verbose debugging stats to the native GC */
 /* #define SEXP_USE_DEBUG_GC 1 */
 
+/* uncomment this to add instrumentation to the native GC */
+/* #define SEXP_USE_TIME_GC 1 */
+
 /* uncomment this to enable "safe" field accessors for primitive types */
 /*   The sexp union type fields are abstracted away with macros of the */
 /*   form sexp_<type>_<field>(<obj>), however these are just convenience */
@@ -384,6 +387,10 @@
 #define SEXP_USE_DEBUG_GC 0
 #endif
 
+#ifndef SEXP_USE_TIME_GC
+#define SEXP_USE_TIME_GC SEXP_USE_DEBUG_GC > 0
+#endif
+
 #ifndef SEXP_USE_SAFE_GC_MARK
 #define SEXP_USE_SAFE_GC_MARK SEXP_USE_DEBUG_GC > 1
 #endif

include/chibi/sexp.h

@@ -465,7 +465,7 @@ struct sexp_struct {
       struct timeval tval;
 #endif
       char tailp, tracep, timeoutp, waitp, errorp;
-      sexp_uint_t last_fp;
+      sexp_uint_t last_fp, gc_usecs;
       sexp stack, env, parent, child,
         globals, dk, params, proc, name, specific, event, result;
 #if SEXP_USE_DL
@@ -1093,6 +1093,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
 #define sexp_context_dk(x)       (sexp_field(x, context, SEXP_CONTEXT, dk))
 #define sexp_context_params(x)   (sexp_field(x, context, SEXP_CONTEXT, params))
 #define sexp_context_last_fp(x)  (sexp_field(x, context, SEXP_CONTEXT, last_fp))
+#define sexp_context_gc_usecs(x) (sexp_field(x, context, SEXP_CONTEXT, gc_usecs))
 #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))

lib/chibi/ast.c

@@ -1,5 +1,5 @@
 /*  ast.c -- interface to the Abstract Syntax Tree            */
-/*  Copyright (c) 2009-2012 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2009-2015 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt       */
 
 #include <chibi/eval.h>
@@ -408,6 +408,10 @@ static sexp sexp_gc_op (sexp ctx, sexp self, sexp_sint_t n) {
   return sexp_make_unsigned_integer(ctx, sum_freed);
 }
 
+static sexp sexp_gc_usecs_op (sexp ctx, sexp self, sexp_sint_t n) {
+  return sexp_make_unsigned_integer(ctx, sexp_context_gc_usecs(ctx));
+}
+
 #if SEXP_USE_GREEN_THREADS
 static sexp sexp_set_atomic (sexp ctx, sexp self, sexp_sint_t n, sexp new_val) {
   sexp res = sexp_global(ctx, SEXP_G_ATOMIC_P);
@@ -647,6 +651,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
   sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
   sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
   sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
+  sexp_define_foreign(ctx, env, "gc-usecs", 0, sexp_gc_usecs_op);
 #if SEXP_USE_GREEN_THREADS
   sexp_define_foreign(ctx, env, "%set-atomic!", 1, sexp_set_atomic);
 #endif

lib/chibi/ast.sld

@@ -34,7 +34,7 @@
    extend-env env-parent env-parent-set! env-lambda env-lambda-set!
    env-define! env-push! env-syntactic? env-syntactic?-set! core-code
    type-name type-cpl type-parent type-slots type-num-slots type-printer
-   object-size integer->immediate gc atomically thread-list abort
+   object-size integer->immediate gc gc-usecs atomically thread-list abort
    string-contains string-cursor-copy! errno integer->error-string
    flatten-dot update-free-vars! setenv unsetenv safe-setenv)
   (import (chibi))

sexp.c

@@ -485,6 +485,7 @@ sexp sexp_make_context (sexp ctx, size_t size, size_t max_size) {
   sexp_context_saves(res) = NULL;
   sexp_context_params(res) = SEXP_NULL;
   sexp_context_last_fp(res) = 0;
+  sexp_context_gc_usecs(res) = 0;
   sexp_context_tracep(res) = 0;
   sexp_context_timeoutp(res) = 0;
   sexp_context_tailp(res) = 1;