From eb749bb535d76f67c91c014212f6837a4012bb50 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 31 Oct 2011 18:59:48 -0700
Subject: [PATCH] tools.profiler.sampling: very basic frontend words

---
 basis/tools/profiler/sampling/sampling.factor | 48 +++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 basis/tools/profiler/sampling/sampling.factor

diff --git a/basis/tools/profiler/sampling/sampling.factor b/basis/tools/profiler/sampling/sampling.factor
new file mode 100644
index 0000000000..ea4a311efb
--- /dev/null
+++ b/basis/tools/profiler/sampling/sampling.factor
@@ -0,0 +1,48 @@
+USING: assocs calendar continuations kernel math.statistics
+namespaces sequences tools.profiler.sampling.private ;
+IN: tools.profiler.sampling
+
+: TIME-PER-SAMPLE ( -- n ) 1 milliseconds ; inline
+
+SYMBOL: raw-profile-data
+
+: get-raw-profile-data ( -- data )
+    raw-profile-data get-global [ "No profile data" throw ] unless* ;
+
+: profile ( quot -- )
+    t profiling [ f profiling ] [ ] cleanup
+    (get-samples) raw-profile-data set-global ; inline
+
+: total-sample-count ( sample -- count ) first ;
+: gc-sample-count ( sample -- count ) second ;
+: foreign-sample-count ( sample -- count ) third ;
+: foreign-thread-sample-count ( sample -- count ) fourth ;
+: sample-context ( sample -- alien ) 4 swap nth ;
+: sample-callstack ( sample -- array ) 5 swap nth ;
+
+: samples>time ( samples -- time )
+    TIME-PER-SAMPLE time* ;
+
+: (total-time) ( samples -- n )
+    [ total-sample-count ] map-sum samples>time ;
+
+: (gc-time) ( samples -- n )
+    [ gc-sample-count ] map-sum samples>time ;
+
+: (foreign-time) ( samples -- n )
+    [ foreign-sample-count ] map-sum samples>time ;
+
+: (foreign-thread-time) ( samples -- n )
+    [ foreign-thread-sample-count ] map-sum samples>time ;
+
+: total-time ( -- n )
+    get-raw-profile-data (total-time) ;
+: gc-time ( -- n )
+    get-raw-profile-data (gc-time) ;
+: foreign-time ( -- n )
+    get-raw-profile-data (foreign-time) ;
+: foreign-thread-time ( -- n )
+    get-raw-profile-data (foreign-thread-time) ;
+
+: time-per-context ( -- n )
+    get-raw-profile-data [ sample-context ] collect-by [ (total-time) ] assoc-map ;