improve linklet performance-logging report

racket/src/cs/linklet.sls

@@ -228,18 +228,18 @@
                     (performance-region
                      'uncompress
                      (bytevector-uncompress c-bv))))])
-      (add-performance-memory! 'faslin (bytevector-length bv))
+      (add-performance-memory! 'faslin-code (bytevector-length bv))
       (cond
        [(eq? format 'interpret)
         (let ([r (performance-region
-                  'faslin
+                  'faslin-code
                   (fasl-read (open-bytevector-input-port bv)))])
           (performance-region
            'outer
            (outer-eval r format)))]
        [else
         (performance-region
-         'faslin
+         'faslin-code
          (code-from-bytevector bv))])))
 
   (define (code-from-bytevector bv)

racket/src/cs/linklet/performance.ss

@@ -54,33 +54,70 @@
            [gc-total (apply + (hash-table-map region-gc-times (lambda (k v) v)))]
            [name-len (apply max (hash-table-map region-times (lambda (k v) (string-length (symbol->string k)))))]
            [len (string-length (number->string total))]
-           [gc-len (string-length (number->string gc-total))])
+           [gc-len (string-length (number->string gc-total))]
-      (define (pad v w)
+           [categories '((read (read-bundle faslin-code))
+                         (comp-ffi (comp-ffi-call comp-ffi-back))
+                         (run (instantiate outer)))]
+           [region-subs (make-eq-hashtable)]
+           [region-gc-subs (make-eq-hashtable)])
+      (define (pad v w combine)
         (let ([s (chez:format "~a" v)])
-          (string-append (make-string (max 0 (- w (string-length s))) #\space)
+          (combine (make-string (max 0 (- w (string-length s))) #\space)
                    s)))
-      (define (report label n n-extra units extra)
+      (define (pad-left v w) (pad v w string-append))
-        (chez:printf ";; ~a:  ~a~a ~a~a\n"
+      (define (pad-right v w) (pad v w (lambda (p s) (string-append s p))))
-                     (pad label name-len)
+      (define (report level label n n-extra units extra)
-                     (pad (round (inexact->exact n)) len)
+        (chez:printf ";; ~a~a~a  ~a~a ~a~a\n"
+                     (make-string (* level 2) #\space)
+                     (pad-right label name-len)
+                     (make-string (* (- 3 level) 2) #\space)
+                     (pad-left (round (inexact->exact n)) len)
                      n-extra
                      units
                      extra))
       (define (ht->sorted-list ht)
         (list-sort (lambda (a b) (< (cdr a) (cdr b)))
                    (hash-table-map ht cons)))
-      (for-each (lambda (p)
+      (define (sum-values ht keys key subs)
-                  (let ([label (car p)]
+        (define sub-ht (make-eq-hashtable))
-                        [n (cdr p)])
+        (hashtable-set! subs key sub-ht)
-                    (report label n
+        (let loop ([keys keys])
-                            (chez:format " [~a]" (pad (hashtable-ref region-gc-times label 0) gc-len))
+          (cond
+           [(null? keys) 0]
+           [else
+            (let* ([sub-key (car keys)]
+                   [v (hashtable-ref ht sub-key 0)])
+              (hashtable-set! sub-ht sub-key v)
+              (hashtable-delete! ht sub-key)
+              (+ v (loop (cdr keys))))])))
+      (define (report-time level label n gc-ht)
+        (report level label n
+                (chez:format " [~a]" (pad-left (hashtable-ref gc-ht label 0) gc-len))
                 'ms
                 (let ([c (hashtable-ref region-counts label 0)])
                   (if (zero? c)
                       ""
-                                  (chez:format " ; ~a times" c))))))
+                      (chez:format " ; ~a times" c)))))
-                (ht->sorted-list region-times))
+      (for-each (lambda (l)
-      (report 'total total (#%format " [~a]" gc-total) 'ms "")
+                  (let* ([cat (car l)]
+                         [subs (cadr l)]
+                         [t (sum-values region-times subs cat region-subs)]
+                         [gc-t (sum-values region-gc-times subs cat region-gc-subs)])
+                    (unless (and (zero? t) (zero? gc-t))
+                      (hashtable-set! region-times cat t)
+                      (hashtable-set! region-gc-times cat gc-t))))
+                categories)
+      (let loop ([ht region-times] [gc-ht region-gc-times] [level 0])
+        (for-each (lambda (p)
+                    (let ([label (car p)]
+                          [n (cdr p)])
+                      (report-time level label n gc-ht)
+                      (let ([sub-ht (hashtable-ref region-subs label #f)]
+                            [sub-gc-ht (hashtable-ref region-gc-subs label #f)])
+                        (when sub-ht
+                          (loop sub-ht sub-gc-ht (add1 level))))))
+                  (ht->sorted-list ht)))
+      (report 0 'total total (#%format " [~a]" gc-total) 'ms "")
       (chez:printf ";;\n")
-      (for-each (lambda (p) (report (car p) (/ (cdr p) 1024 1024) "" 'MB ""))
+      (for-each (lambda (p) (report 0 (car p) (/ (cdr p) 1024 1024) "" 'MB ""))
                 (ht->sorted-list region-memories)))))

racket/src/cs/linklet/read.ss

@@ -1,6 +1,6 @@
 (define (read-compiled-linklet in)
   (performance-region
-   'read
+   'read-bundle
    (read-compiled-linklet-or-directory in #t)))
 
 (define (read-compiled-linklet-or-directory in initial?)

racket/src/cs/rumble/foreign.ss

@@ -1407,7 +1407,7 @@
                         (weak-hash-ref ffi-expr->code expr #f))]
                    [code (if wb (car wb) #!bwp)])
               (if (eq? code #!bwp)
-                  (let ([code (eval/foreign expr (if call? 'comp-ffi 'comp-ffi-back))])
+                  (let ([code (eval/foreign expr (if call? 'comp-ffi-call 'comp-ffi-back))])
                     (hashtable-set! ffi-code->expr (car code) expr)
                     (with-interrupts-disabled
                      (weak-hash-set! ffi-expr->code expr (weak-cons code #f)))

racket/src/expander/namespace/module.rkt

@@ -372,7 +372,9 @@
                                        #:seen [seen #hasheq()])
   (unless (module-path-index? mpi)
     (error "not a module path index:" mpi))
-  (define name (module-path-index-resolve mpi #t))
+  (define name (performance-region
+                ['eval 'resolve]
+                (module-path-index-resolve mpi #t)))
   (define m (namespace->module ns name))
   (unless m (raise-unknown-module-error 'instantiate name))
   (define (instantiate! instance-phase run-phase ns)

racket/src/foreign/foreign.rktc

@@ -2957,7 +2957,7 @@ static Scheme_Object *ffi_call_or_curry(const char *who, int curry, int argc, Sc
   scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
   a[0] = data;
 
-  scheme_performance_record_end("comp-ffi", &perf_state);
+  scheme_performance_record_end("comp-ffi-call", &perf_state);
 
   if (curry) {
     return scheme_make_prim_closure_w_arity(make_ffi_call_from_curried, 

racket/src/racket/src/linklet.c

@@ -1741,6 +1741,26 @@ typedef struct {
 
 static Performance_Entry perf_entries[MAX_PERF_ENTRIES];
 
+#define MAX_PERF_CATS    3
+#define MAX_PERF_SUBS    3
+
+typedef struct {
+  const char *name;
+  Performance_Entry perf_entries[MAX_PERF_SUBS];
+  int perf_count;
+} Performance_Cat;
+
+typedef struct {
+  const char *entry;
+  const char *cat;
+} Performace_Recat;
+
+static Performace_Recat recats[] = { { "instantiate", "run" },
+                                     { "jit", "run" },
+                                     { "comp-ffi-call", "comp-ffi" },
+                                     { "comp-ffi-back", "comp-ffi" },
+                                     { NULL, NULL} };
+
 static char *do_tab(int len, char *tab, int max_len)
 {
   int i;
@@ -1778,7 +1798,7 @@ static char *tab_string(const char *s, char *tab, int max_len)
   return do_tab(strlen(s), tab, max_len);
 }
 
-static void sort_perf(int lo, int hi)
+static void sort_perf(Performance_Entry *pref_entries, int lo, int hi)
 {
   int i, pivot;
   
@@ -1796,26 +1816,66 @@ static void sort_perf(int lo, int hi)
     }
   }
 
-  sort_perf(lo, pivot);
+  sort_perf(perf_entries, lo, pivot);
-  sort_perf(pivot+1, hi);
+  sort_perf(perf_entries, pivot+1, hi);
 }
 
-static void show_perf()
+static void show_perf(Performance_Entry *perf_entries, int perf_count,
+                      int len, int name_len,
+                      int depth)
 {
   intptr_t total = 0, gc_total = 0;
-  int i, name_len = 0, len, gc_len;
+  int i, j, k, m, n, gc_len;
-  char name_tab[16], tab[10], gc_tab[10];
+  char name_tab[16], tab[10], gc_tab[10], pre_indent[8], post_indent[8];
+  Performance_Cat cats[MAX_PERF_CATS];
+  int num_cats = 0;
 
-  sort_perf(0, perf_count);
+  memset(cats, 0, sizeof(cats));
+
+  if (!depth) {
+    for (i = 0; i < perf_count; i++) {
+      for (j = 0; recats[j].entry; j++) {
+        if (!strcmp(recats[j].entry, perf_entries[i].name)) {
+          for (m = 0; m < num_cats; m++) {
+            if (!strcmp(recats[j].cat, cats[m].name))
+              break;
+          }
+          if (num_cats <= m) num_cats = m+1;
+          cats[m].name = recats[j].cat;
+          for (k = 0; k < perf_count; k++) {
+            if (perf_entries[k].name) {
+              if (!strcmp(perf_entries[k].name, recats[j].cat))
+                break;
+            } else
+              break;
+          }
+          perf_entries[k].name = recats[j].cat;
+          if (perf_count <= k) perf_count = k+1;
+          perf_entries[k].accum += perf_entries[i].accum;
+          perf_entries[k].gc_accum += perf_entries[i].gc_accum;
+          perf_entries[k].count += perf_entries[i].count;
+
+          n = cats[m].perf_count++;
+          cats[m].perf_entries[n] = perf_entries[i];
+          perf_entries[i].accum = 0;
+          perf_entries[i].gc_accum = 0;
+          perf_entries[i].count = 0;
+        }
+      }
+    }
+  }
+
+  sort_perf(perf_entries, 0, perf_count);
 
   for (i = 0; i < perf_count; i++) {
-    len = strlen(perf_entries[i].name);
+    n = strlen(perf_entries[i].name);
-    if (len > name_len) name_len = len;
+    if (n > name_len) name_len = n;
     total += perf_entries[i].accum;
     gc_total += perf_entries[i].gc_accum;
   }
 
-  len = numlen(total);
+  n = numlen(total);
+  if (n > len) len = n;
   gc_len = numlen(gc_total);
 
   if (name_len >= sizeof(name_tab))
@@ -1825,25 +1885,48 @@ static void show_perf()
   if (gc_len >= sizeof(gc_tab))
     gc_len = sizeof(gc_tab) -1;
 
+  for (i = 0; i < depth * 2; i++) {
+    pre_indent[i] = ' ';
+  }
+  pre_indent[i] = 0;
+  for (i = 0; i < (3 - depth) * 2; i++) {
+    post_indent[i] = ' ';
+  }
+  post_indent[i] = 0;
+  
   for (i = 0; i < perf_count; i++) {
-    fprintf(stderr, ";; %s%s:  %s%"PRIdPTR " [%s%"PRIdPTR"] ms ; %"PRIdPTR" times\n",
+    if (perf_entries[i].count)
-            tab_string(perf_entries[i].name, name_tab, name_len),
+      fprintf(stderr, ";; %s%s%s%s  %s%"PRIdPTR " [%s%"PRIdPTR"] ms ; %"PRIdPTR" times\n",
+              pre_indent,
               perf_entries[i].name,
+              tab_string(perf_entries[i].name, name_tab, name_len),
+              post_indent,
               tab_number(perf_entries[i].accum, tab, len),
               perf_entries[i].accum,
               tab_number(perf_entries[i].gc_accum, gc_tab, gc_len),
               perf_entries[i].gc_accum,
               perf_entries[i].count);
+    for (m = 0; m < num_cats; m++) {
+      if (!strcmp(perf_entries[i].name, cats[m].name))
+        show_perf(cats[m].perf_entries, cats[m].perf_count, len, name_len, depth+1);
+    }
   }
 
-  fprintf(stderr, ";; %stotal:  %s%"PRIdPTR " [%s%"PRIdPTR"] ms\n",
+  if (!depth)
-          tab_string("total", name_tab, name_len),
+    fprintf(stderr, ";; %stotal%s  %s%"PRIdPTR " [%s%"PRIdPTR"] ms\n",
             tab_number(total, tab, len),
+            tab_string("total", name_tab, name_len),
+            post_indent,
             total,
             tab_number(gc_total, gc_tab, gc_len),
             gc_total);
 }
 
+static void show_all_perf()
+{
+  return show_perf(perf_entries, perf_count, 0, 0, 0);
+}
+
 void scheme_performance_record_start(GC_CAN_IGNORE Scheme_Performance_State *perf_state)
 {
 #if defined(MZ_USE_PLACES)
@@ -1854,7 +1937,7 @@ void scheme_performance_record_start(GC_CAN_IGNORE Scheme_Performance_State *per
   if (!perf_reg) {
     if (scheme_getenv("PLT_LINKLET_TIMES")) {
       perf_reg = 1;
-      scheme_atexit(show_perf);
+      scheme_atexit(show_all_perf);
     } else {
       perf_reg = -1;
     }