diff --git a/extra/wordtimer/authors.txt b/extra/wordtimer/authors.txt new file mode 100644 index 0000000000..0be42b2faa --- /dev/null +++ b/extra/wordtimer/authors.txt @@ -0,0 +1 @@ +Phil Dawes diff --git a/extra/wordtimer/summary.txt b/extra/wordtimer/summary.txt new file mode 100644 index 0000000000..efe591da27 --- /dev/null +++ b/extra/wordtimer/summary.txt @@ -0,0 +1 @@ +Microsecond precision code timer/profiler. diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor new file mode 100644 index 0000000000..47b85bb007 --- /dev/null +++ b/extra/wordtimer/wordtimer-docs.factor @@ -0,0 +1,41 @@ +USING: help.syntax help.markup kernel prettyprint sequences ; +IN: wordtimer + +HELP: reset-word-timer +{ $description "resets the global wordtimes datastructure. Must be called before calling any word-timer annotated code" +} ; + +HELP: add-timer +{ $values { "word" "a word" } } +{ $description "annotates the word with timing code which stores timing information globally. You can then view the info with print-word-timings" +} ; + +HELP: add-timers +{ $values { "vocab" "a string" } } +{ $description "annotates all the words in the vocab with timer code. After profiling you can remove the annotations with reset-vocab" +} ; + + +HELP: reset-vocab +{ $values { "vocab" "a string" } } +{ $description "removes the annotations from all the words in the vocab" +} ; + +HELP: print-word-timings +{ $description "Displays the timing information for each word-timer annotated word. Columns are: total time taken in microseconds, number of invocations, wordname" +} ; + +HELP: correct-for-timing-overhead +{ $description "attempts to correct the timings to take into account the overhead of the timing function. This is pretty error-prone but can be handy when you're timing words that only take a handful of milliseconds but are called a lot" } ; + +HELP: profile-vocab +{ $values { "vocabspec" "string name of a vocab" } + { "quot" "a quotation to run" } } +{ $description "Annotates the words in the vocab with timing code then runs the quotation. Finally resets the words and prints the timings information." +} ; + + +ARTICLE: "wordtimer" "Word Timer" +"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } ". Alternatively if you just want to time the contents of a vocabulary you can use profile-vocab." ; + +ABOUT: "wordtimer" diff --git a/extra/wordtimer/wordtimer-tests.factor b/extra/wordtimer/wordtimer-tests.factor new file mode 100644 index 0000000000..47287179ce --- /dev/null +++ b/extra/wordtimer/wordtimer-tests.factor @@ -0,0 +1,10 @@ +USING: tools.test wordtimer math kernel tools.annotations prettyprint ; +IN: wordtimer.tests + +: testfn ( a b c d -- a+b c+d ) + + [ + ] dip ; + +[ 3 7 ] +[ reset-word-timer + \ testfn [ reset ] [ add-timer ] bi + 1 2 3 4 testfn ] unit-test \ No newline at end of file diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor new file mode 100644 index 0000000000..5da17e28d5 --- /dev/null +++ b/extra/wordtimer/wordtimer.factor @@ -0,0 +1,81 @@ +USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics accessors ; +IN: wordtimer + +SYMBOL: *wordtimes* +SYMBOL: *calling* + +: reset-word-timer ( -- ) + H{ } clone *wordtimes* set-global + H{ } clone *calling* set-global ; + +: lookup-word-time ( wordname -- utime n ) + *wordtimes* get-global [ drop { 0 0 } ] cache first2 ; + +: update-times ( utime current-utime current-numinvokes -- utime' invokes' ) + rot [ + ] curry [ 1+ ] bi* ; + +: register-time ( utime word -- ) + name>> + [ lookup-word-time update-times 2array ] keep *wordtimes* get-global set-at ; + +: calling ( word -- ) + dup *calling* get-global set-at ; inline + +: finished ( word -- ) + *calling* get-global delete-at ; inline + +: called-recursively? ( word -- t/f ) + *calling* get-global at ; inline + +: timed-call ( quot word -- ) + [ calling ] [ >r micro-time r> register-time ] [ finished ] tri ; inline + +: time-unless-recursing ( quot word -- ) + dup called-recursively? not + [ timed-call ] [ drop call ] if ; inline + +: (add-timer) ( word quot -- quot' ) + [ swap time-unless-recursing ] 2curry ; + +: add-timer ( word -- ) + dup [ (add-timer) ] annotate ; + +: add-timers ( vocabspec -- ) + words [ add-timer ] each ; + +: reset-vocab ( vocabspec -- ) + words [ reset ] each ; + +: dummy-word ( -- ) ; + +: time-dummy-word ( -- n ) + [ 100000 [ [ dummy-word ] micro-time , ] times ] { } make median ; + +: subtract-overhead ( {oldtime,n} overhead -- {newtime,n} ) + [ first2 ] dip + swap [ * - ] keep 2array ; + +: change-global ( variable quot -- ) + global swap change-at ; + +: (correct-for-timing-overhead) ( timingshash -- timingshash ) + time-dummy-word [ subtract-overhead ] curry assoc-map ; + +: correct-for-timing-overhead ( -- ) + *wordtimes* [ (correct-for-timing-overhead) ] change-global ; + +: print-word-timings ( -- ) + *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ; + + +: profile-vocab ( vocabspec quot -- ) + "annotating vocab..." print flush + over [ reset-vocab ] [ add-timers ] bi + reset-word-timer + "executing quotation..." print flush + [ call ] micro-time >r + "resetting annotations..." print flush + reset-vocab + correct-for-timing-overhead + "total time:" write r> pprint + print-word-timings ; \ No newline at end of file