comment:
Dirk's simple Profiler.
Written March 31st, 2003 by dirkNO@SPAMwin32forth.org (dbu)
revised April 13th, 2003 by dirkNO@SPAMwin32forth.org (dbu)
revised April 18th, 2003 by dirkNO@SPAMwin32forth.org (dbu)
comment;
cls .( loading Dirk's simple Forth-Profiler. ) cr
: d@ ( addr -- d )
2@ swap
;
\ -----------------------------------------------------------------------------
\ get the frequency of the PerformanceCounter
\ -----------------------------------------------------------------------------
: get-counter-frequency ( -- f: frequency )
\ get the frequency
here rel>abs CALL QueryPerformanceFrequency ?win-error
here d@
d>f f1.0 f/
;
get-counter-frequency fconstant counter-frequency
\ -----------------------------------------------------------------------------
\ run the word an stop the time
\ -----------------------------------------------------------------------------
variable profile-cfa \ holds the cfa of our word to profile
2variable profile-start \ holds the start-time (in counter-ticks)
2variable profile-end \ holds the end-time (in counter-ticks)
10 value profile-times \ for acuracy we profile the word this many times
2variable counter-overhead \ holds the runtime overhead (in counter-ticks)
: (run-profiler) ( -- )
\ let any other stuff happen before we start
PM_NOREMOVE 0 0 0 here rel>abs call PeekMessage drop
0 call Sleep drop
\ set our thread to the highest priority level
THREAD_PRIORITY_TIME_CRITICAL call GetCurrentThread call SetThreadPriority ?win-error
\ run the word, stop the time
profile-start rel>abs CALL QueryPerformanceCounter ?win-error
profile-cfa PERFORM
profile-end rel>abs CALL QueryPerformanceCounter ?win-error
\ set the priority of our thread back to normal
THREAD_PRIORITY_NORMAL call GetCurrentThread call SetThreadPriority ?win-error
;
: calc-delta-time ( -- d )
\ calc delta-time
profile-end d@
profile-start d@
D-
\ just remember our runtime overhead
counter-overhead 2@ D-
;
: run-profiler ( -- f: runtime )
0.
\ since timeing under window's isn't very acurate we
\ do the timeing more than once
profile-times 0 do
(run-profiler)
calc-delta-time
d+
loop
profile-times FM/MOD NIP s>f
;
\ -----------------------------------------------------------------------------
\ determine the runtime overhead
\ -----------------------------------------------------------------------------
: (get-counter-overhead) ;
' (get-counter-overhead) profile-cfa !
0. counter-overhead 2! \ we haven't any overhead yet
run-profiler f>d counter-overhead 2!
\ -----------------------------------------------------------------------------
\ -----------------------------------------------------------------------------
: (profiler) ( cfa -- )
cr ." Profiling " dup .name
\ store the cfa
profile-cfa !
\ run the profiler
run-profiler
\ and print results
base @ decimal
counter-frequency f/ f. ." seconds"
base !
;
: profiler ( -- )
' (profiler)
;
\ this is how to use:
: test
1 0 do
100 call Sleep drop
loop ;
profiler test
comment:
Well after I wrote this simple profiler I found a similar word called "elapse"
in the File "utils.f". A more accurate replacement for elapse can be like this:
comment;
: ms@ ( -- ms )
here rel>abs CALL QueryPerformanceCounter ?win-error
here d@ d>f \ timer-ticks
counter-frequency f/ \ seconds
1000 s>f f* \ milli-seconds
f>s
;
0 value start-time
: time-reset ( -- )
ms@ to start-time ;
' time-reset alias timer-reset
: .elapsed ( -- )
." Elapsed time: "
1000 /mod
60 /mod
60 /mod 2 .#" type ." :"
2 .#" type ." :"
2 .#" type ." ."
3 .#" type
;
: elapse ( -<commandline>- )
\ let any other stuff happen before we start
PM_NOREMOVE 0 0 0 here rel>abs call PeekMessage drop
0 call Sleep drop
\ set our thread to the highest priority level
THREAD_PRIORITY_TIME_CRITICAL call GetCurrentThread call SetThreadPriority ?win-error
time-reset interpret ms@ start-time -
\ set the priority of our thread back to normal
THREAD_PRIORITY_NORMAL call GetCurrentThread call SetThreadPriority ?win-error
cr .elapsed
;
elapse test