comment:

Dirk's simple Profiler.

Written March 31st, 2003 by dirk@schneider-busch.de (dbu)
revised April 13th, 2003 by dirk@schneider-busch.de (dbu)
revised April 18th, 2003 by dirk@schneider-busch.de (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