steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools.profiler.sampling: flat profile report

db4
Joe Groff 2011-11-01 19:39:22 -07:00
parent fd96103d50
commit fb837b91dc
1 changed files with 28 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
basis/tools/profiler/sampling/sampling.factor
View File

@ -3,8 +3,9 @@ USING: accessors assocs calendar combinators
combinators.short-circuit continuations fry io kernel combinators.short-circuit continuations fry io kernel
kernel.private locals math math.statistics math.vectors memory kernel.private locals math math.statistics math.vectors memory
namespaces prettyprint sequences sorting namespaces prettyprint sequences sorting
tools.profiler.sampling.private ; tools.profiler.sampling.private hashtables.identity generalizations ;
FROM: sequences => change-nth ; FROM: sequences => change-nth ;
FROM: assocs => change-at ;
IN: tools.profiler.sampling IN: tools.profiler.sampling
SYMBOL: raw-profile-data SYMBOL: raw-profile-data
@ -29,7 +30,7 @@ CONSTANT: ignore-words
: gc-sample-count ( sample -- count ) second ; : gc-sample-count ( sample -- count ) second ;
: foreign-sample-count ( sample -- count ) third ; : foreign-sample-count ( sample -- count ) third ;
: foreign-thread-sample-count ( sample -- count ) fourth ; : foreign-thread-sample-count ( sample -- count ) fourth ;
: sample-context ( sample -- alien ) 4 swap nth ; : sample-thread ( sample -- alien ) 4 swap nth ;
: sample-callstack ( sample -- array ) 5 swap nth ; : sample-callstack ( sample -- array ) 5 swap nth ;
: samples>time ( samples -- time ) : samples>time ( samples -- time )
@ -56,11 +57,11 @@ CONSTANT: ignore-words
: foreign-thread-time ( -- n ) : foreign-thread-time ( -- n )
get-raw-profile-data (foreign-thread-time) ; get-raw-profile-data (foreign-thread-time) ;
: collect-contexts ( samples -- by-top ) : collect-threads ( samples -- by-top )
[ sample-context ] collect-by ; [ sample-thread ] collect-by ;
: time-per-context ( -- n ) : time-per-thread ( -- n )
get-raw-profile-data collect-contexts [ (total-time) ] assoc-map ; get-raw-profile-data collect-threads [ (total-time) ] assoc-map ;
: unclip-callstack ( sample -- sample' callstack-top ) : unclip-callstack ( sample -- sample' callstack-top )
clone 5 over [ unclip swap ] change-nth ; clone 5 over [ unclip swap ] change-nth ;
@ -69,13 +70,13 @@ TUPLE: profile-node
total-time gc-time foreign-time foreign-thread-time children ; total-time gc-time foreign-time foreign-thread-time children ;
: <profile-node> ( times children -- node ) : <profile-node> ( times children -- node )
[ first4 ] dip profile-node boa ; [ first4 [ samples>time ] 4 napply ] dip profile-node boa ;
: leaf-callstack? ( callstack -- ? ) : leaf-callstack? ( callstack -- ? )
[ ignore-words member? ] all? ; [ ignore-words member? ] all? ;
: sum-times ( samples -- times ) : sum-times ( samples -- times )
{ 0 0 0 0 } [ 4 head-slice v+ ] reduce [ samples>time ] map! ; { 0 0 0 0 } [ 4 head-slice v+ ] reduce ;
:: (collect-subtrees) ( samples child-quot -- children ) :: (collect-subtrees) ( samples child-quot -- children )
samples [ sample-callstack leaf-callstack? not ] filter samples [ sample-callstack leaf-callstack? not ] filter
@ -98,13 +99,30 @@ TUPLE: profile-node
dup redundant-root-node? [ children>> values first trim-root ] when ; dup redundant-root-node? [ children>> values first trim-root ] when ;
: (top-down) ( samples -- tree ) : (top-down) ( samples -- tree )
collect-contexts [ collect-threads [
[ sum-times ] [ collect-tops ] bi <profile-node> trim-root [ sum-times ] [ collect-tops ] bi <profile-node> trim-root
] assoc-map ; ] assoc-map ;
: top-down ( -- tree ) : top-down ( -- tree )
get-raw-profile-data (top-down) ; get-raw-profile-data (top-down) ;
:: collect-flat ( samples -- flat )
IH{ } clone :> per-word-samples
samples [| sample |
sample sample-callstack unique keys [
per-word-samples [ { 0 0 0 0 } or sample 4 head-slice v+ ] change-at
] each
] each
per-word-samples [ f <profile-node> ] assoc-map ;
: (flat) ( samples -- flat )
collect-threads [
[ sum-times ] [ collect-flat ] bi <profile-node>
] assoc-map ;
: flat ( -- tree )
get-raw-profile-data (flat) ;
: depth. ( depth -- ) : depth. ( depth -- )
[ " " write ] times ; [ " " write ] times ;
@ -125,7 +143,7 @@ DEFER: (profile.)
} cleave ; } cleave ;
:: (profile-node.) ( word node depth -- ) :: (profile-node.) ( word node depth -- )
depth depth. node times. ": " write word pprint nl depth depth. node times. ": " write word pprint-short nl
node children>> depth 1 + (profile.) ; node children>> depth 1 + (profile.) ;
: (profile.) ( nodes depth -- ) : (profile.) ( nodes depth -- )