timing is not as clear cut as you might think sadly. (blame MicroSoft for that)
The main concept behind the following GetTimeCount() is that if you only do something once, you can do it many times more than you normally could.
Yes I know, it's a paradox in itself, but trust me, it makes sense once you understand the source, really it does
Code: Select all
;GetTimeCount() v1.1
;(c) Roger "Rescator" Hågensen 2007
;http://EmSai.net/
;This source should be considered MIT/zlib/PNG licensed.
;
;v1.0 2007-07-11
;First release
;
;v1.1 2007-07-12
;Created a "smart" if-QPC-is-safe test, more examples, tweaked code, more comments,
;started preparing source for possible future portability. (Linux and Mac peeps feel free to try :)
EnableExplicit
;Some handy macros and procedures I use.
Macro Max(a,b)
((Not a>b)*b)|((Not b>a)*a)
EndMacro
Macro Min(a,b)
((Not a<b)*b)|((Not b<a)*a)
EndMacro
;For games it is adviced to use StartTimeCounter() at program start.
;And StopTimeCounter() at program end.
;Defaults to 2 microsecond, 1ms may impact system performance, use with care.
Macro StartTimeCounter(resolution=2)
ControlTimeCounter(resolution,#True)
EndMacro ;returns #True if timecounter could be started, #False if not.
Macro StopTimeCounter()
ControlTimeCounter()
EndMacro
;Clever little thing this one, looks like a function but is really a global var.
Global _GetTimeCount_global_var_.l=#Null
Macro GetTimeCount()
_GetTimeCount_global_var_
EndMacro
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
;{ Start of Windows implementation.
Structure POWER_ACTION_POLICY
Action.l
Flags.l
EventCode.l
EndStructure
Structure SYSTEM_POWER_LEVEL
Enable.b
Spare.b[3]
BatteryLevel.l
PowerPolicy.POWER_ACTION_POLICY
MinSystemState.l
EndStructure
#SystemPowerPolicyCurrent=8
#NUM_DISCHARGE_POLICIES=4
Structure SYSTEM_POWER_POLICY
Revision.l
PowerButton.POWER_ACTION_POLICY
SleepButton.POWER_ACTION_POLICY
LidClose.POWER_ACTION_POLICY
LidOpenWake.l
Reserved.l
Idle.POWER_ACTION_POLICY
IdleTimeout.l
IdleSensitivity.b
DynamicThrottle.b
Spare2.b[2]
MinSleep.l
MaxSleep.l
ReducedLatencySleep.l
WinLogonFlags.l
Spare3.l
DozeS4Timeout.l
BroadcastCapacityResolution.l
DischargePolicy.SYSTEM_POWER_LEVEL[#NUM_DISCHARGE_POLICIES]
VideoTimeout.l
VideoDimDisplay.l
VideoReserved.l[3]
SpindownTimeout.l
OptimizeForPower.l
FanThrottleTolerance.b
ForcedThrottle.b
MinThrottle.b
OverThrottled.POWER_ACTION_POLICY
EndStructure
Procedure.l NumberOfCPUs()
Protected sys.SYSTEM_INFO
GetSystemInfo_(sys)
If sys\dwNumberOfProcessors>0
ProcedureReturn sys\dwNumberOfProcessors
Else ;In case GetSystemInfo failed.
ProcedureReturn 1 ;Ever heard of a system with no CPU? *laughs*
EndIf
EndProcedure
#PO_THROTTLE_NONE=0
#PO_THROTTLE_CONSTANT=1
#STATUS_SUCCESS=$00000000
#STATUS_ACCESS_DENIED=$C0000022
#STATUS_BUFFER_TOO_SMALL=$C0000023
Procedure.l IsDynamicThrottleActive() ;Requires Win98 or above
Protected result.l=#False,spp.SYSTEM_POWER_POLICY,error.l
Protected powrprofdll.l=#Null,CallNtPowerInformation=#Null
If OSVersion()>=#PB_OS_Windows_98 ;CallNtPowerInformation is only Win98 or later.
result=#True ;We will err on the safe side, since if we can't determine if
;throttling is active or not we have to assume it is.
powrprofdll=OpenLibrary(#PB_Any,"powrprof.dll")
If powrprofdll
CallNtPowerInformation=GetFunction(powrprofdll,"CallNtPowerInformation")
If CallNtPowerInformation
error=CallFunctionFast(CallNtPowerInformation,#SystemPowerPolicyCurrent,#Null,#Null,spp,SizeOf(SYSTEM_POWER_POLICY))
If error=#STATUS_SUCCESS
If (spp\DynamicThrottle=#PO_THROTTLE_NONE) Or (spp\DynamicThrottle=#PO_THROTTLE_CONSTANT)
result=#False
EndIf
EndIf
EndIf
CloseLibrary(powrprofdll)
EndIf
EndIf
ProcedureReturn result
EndProcedure
;REALTIME_PRIORITY_CLASS is not adviced. Process priority also affect the
;thread priorities as they are based on top of process priority.
;I.e: threadpriority=processpriority+threadprioritybase
;Well, at least on the Windows platform that is.
;level can be #REALTIME_PRIORITY_CLASS, #HIGH_PRIORITY_CLASS, #NORMAL_PRIORITY_CLASS,
;#IDLE_PRIORITY_CLASS, 2000/XP/2003 also have #ABOVE_NORMAL_PRIORITY_CLASS and
;#BELOW_NORMAL_PRIORITY_CLASS, same for Vista but be aware of the security/access rights.
Procedure.l ChangeOwnProcessPriority(level=#Null)
Protected process.l,result.l=#False
Static priority.l
If level
process=GetCurrentProcess_()
If process
priority=GetPriorityClass_(process)
If priority
If SetPriorityClass_(process,level)
result=#True
EndIf
EndIf
EndIf
Else
If priority
SetPriorityClass_(process,priority)
priority=#Null
EndIf
EndIf
ProcedureReturn result
EndProcedure
;This one is used via the nice macros further below.
;Defaults to 2 microsecond, 1ms may impact system performance, use with care.
;Sleep_() and suff like page faults, event timers and waitobjects and more is affected too,
;as well as the system thread scheduler and similar Windows OS features.
;Note! Several media software tends to adjust this as well,
;MS documetation states that as long as other apps has adjusted the timing it can onlybe lowered
;this is to ensure that the apps that need media timing do not get suddenly worse results.
Procedure SetTimePeriod(resolution.l=2)
Static wTimerRes.l=-1,a.l
Protected tc.TIMECAPS
If resolution=-1
If wTimerRes<>-1
timeEndPeriod_(wTimerRes)
wTimerRes=-1
EndIf
Else
If timeGetDevCaps_(tc,SizeOf(TIMECAPS))=#TIMERR_NOERROR
wTimerRes=Min(Max(tc\wPeriodMin,resolution),tc\wPeriodMax)
Else
tc\wPeriodMin=1 ;Fallback to "safe" values in case devcaps failed
tc\wPeriodMax=10 ;(x86 NT kernel range)
EndIf
wTimerRes=Min(Max(tc\wPeriodMin,resolution),tc\wPeriodMax)
If timeBeginPeriod_(wTimerRes)<>#TIMERR_NOERROR : wTimerRes=-1 : EndIf
EndIf
;To make sure the timing has changed before we continue, let's sleep a little.
If wTimerRes=-1
Sleep_(1)
Else
Sleep_(wTimerRes)
EndIf
ProcedureReturn wTimerRes
EndProcedure
;I seperated this out (was part of ReadTimeGetTime_thread() start originally)
;so that you can use the check in case you wish to roll your own timer,
;or call QueryPerformanceCounter_() directly in your loops if it's deemed safe.
;Don't forget to make use of the SetTimePeriod() procedure to gaint that extra accuracy
;for Delay's and similar stuff in your game or time critical app.
;And if you make your own timer thread, don't forget to increase that thread's priority.
;Tip! Save the result of this one into a global var like QPC_Safe, that way you can
;easily pick QPC or someting else for your loop timings with minimal overhead.
Procedure IsQueryPerformanceCounterSafe()
Protected result.l=#False,freq,q,process.l,affinity.l,sysmask.l
;Get QPC timer frequency.
QueryPerformanceFrequency_(@freq)
;Check for safe frequencies.
If (IsDynamicThrottleActive()=#False) Or (freq=14318180) Or (freq=3579545) Or (freq=1193182)
;CPU throttling off so TSC usable, it "should" be safe to use QPC on multicore CPUs.
;Or a HPET, ACPI/PMT, PIT, or emulation of these timers was detected so multicore safe(!)
result=#True
;If QPC is deemed not deemed safe and there is a unknown frequency value, (like TSC)
;we will use the slightly lower precision timeGetTime_() instead. aka TGT
;It uses the system timer, which could be HPET, ACPI/PMT, PIT, or emulation derived.
;RDTSC/TSC timer can not be used as it is affected by CPU throttling/powersaving mode.
;We are not using GetTickCount (GTC) or GetSystemTimeAsFileTime (STAFT) due to accuracy issues.
EndIf
ProcedureReturn result
EndProcedure
;This is our workhorse thread proc.
Procedure ReadTimeGetTime_thread()
Protected freq,q,count.q,freqdiv.d,process.l,affinity.l,sysmask.l,msk.l,i.l
;Ensure the timer thread always runs on the same CPU core.
If NumberOfCPUs()>1
process=GetCurrentProcess_()
If process
If GetProcessAffinityMask_(process,@affinity,@sysmask)<>#Null
msk.l=$1
For i=0 To 31
If affinity&msk
If SetThreadAffinityMask_(GetCurrentThread_(),affinity&msk)<>#Null
;Thread hopefully set to the first CPU we found that we are "allowed" to use!
Break
EndIf
EndIf
msk<<1
Next
;Either it works or it does not, not much one can do (easily) if it fails.
;Except hoping the thread do not get bounced to often between CPUs. *laughs*
EndIf
EndIf
EndIf
If IsQueryPerformanceCounterSafe()
;Get QPC timer frequency.
QueryPerformanceFrequency_(@freq)
freqdiv=freq/1000 ;Pre calc to save some cycles in the loop.
Repeat
QueryPerformanceCounter_(@count) ;Takes around ~3ms (PIT), 700ns (PMT), 100 clocks (TSC).
GetTimeCount()=count/freqdiv
Sleep_(1) ;Do not use 0, as that combined with a higher thread priority hogs the system.
ForEver
Else
Repeat
GetTimeCount()=timeGetTime_() ;Takes around 102 clocks.
Sleep_(1) ;Do not use 0, as that combined with a higher thread priority hogs the system.
ForEver
EndIf
EndProcedure
Procedure.l ControlTimeCounter(resolution=2,start=#False)
Protected result.l=#False
Static thread.l=#Null
If start
If thread=#Null
SetTimePeriod(resolution)
thread=CreateThread(@ReadTimeGetTime_thread(),#Null)
If thread
ThreadPriority(thread,32)
result=#True
If resolution<>-1
Sleep_(resolution)
EndIf
EndIf
Else
SetTimePeriod(-1)
EndIf
Else
KillThread(thread) : thread=#Null
SetTimePeriod(-1)
EndIf
ProcedureReturn result ;#True if timecounter could be started, #False if not.
EndProcedure
;} End of Windows implementation.
CompilerCase #PB_OS_Linux
;{ Start of Linux implementation
;Well, the humble beginnings of it rather.
Procedure ReadTimeGetTime_thread()
;Ensure the timer thread always runs on the same CPU core.
;SetThreadAffinityMask_(GetCurrentThread_(),1) ;What is the Linux equivalent?
Repeat
GetTimeCount()=ElapsedMilliseconds() ;This uses gettimeofday() ?
Delay(1) ;Do not use 0, as that combined with a higher thread priority hogs the system.
ForEver
EndIf
EndProcedure
Procedure.l ControlTimeCounter(resolution=2,start=#False)
Protected result.l=#False
Static thread.l=#Null
If start
If thread=#Null
thread=CreateThread(@ReadTimeGetTime_thread(),#Null)
If thread
ThreadPriority(thread,32)
result=#True
Delay(1)
EndIf
EndIf
Else
KillThread(thread) : thread=#Null
EndIf
ProcedureReturn result ;#True if timecounter could be started, #False if not.
EndProcedure
;} End of Linux implementation
CompilerCase #PB_OS_MacOS
;{ Start of Mac implementation
;Well, the humble beginnings of it rather.
Procedure ReadTimeGetTime_thread()
;Ensure the timer thread always runs on the same CPU core.
;SetThreadAffinityMask_(GetCurrentThread_(),1) ;What is the Mac equivalent?
Repeat
GetTimeCount()=ElapsedMilliseconds()
Delay(1) ;Do not use 0, as that combined with a higher thread priority hogs the system.
ForEver
EndIf
EndProcedure
Procedure.l ControlTimeCounter(resolution=2,start=#False)
Protected result.l=#False
Static thread.l=#Null
If start
If thread=#Null
thread=CreateThread(@ReadTimeGetTime_thread(),#Null)
If thread
ThreadPriority(thread,32)
result=#True
Delay(1)
EndIf
EndIf
Else
KillThread(thread) : thread=#Null
EndIf
ProcedureReturn result ;#True if timecounter could be started, #False if not.
EndProcedure
;} End of Mac implementation
CompilerDefault
CompilerError "No implementation!"
CompilerEndSelect
;Just cross platform stuff next, until the tests further below.
;This neat little thing shows the current system time latency
;The integer is the latency, since the minimum "sleep" is 1ms
;any fraction is most likely overhead but it could indicate a hardware or OS timing issue.
;On Windows OS timeBeginPeriod_() also affect the latency.
;This Procedure depends on StartTimeCounter() having been started, it is still safe to
;use it even if not running, but the result is useless obviously as it is not updated.
Procedure.f GetTimePeriodLatency()
Protected start.l,stop.l,time.l,n.l
start=GetTimeCount()
Repeat
stop=GetTimeCount()
Delay(1)
n+1
time=(stop-start)
Until time>999
ProcedureReturn (time/n)
EndProcedure
;******************************************************************************
;******************************************************************************
;******************************* example uses *********************************
;******************************************************************************
;******************************************************************************
;Note! There is no error checking wether things has started/working etc.
;These are just quick and dirty examples of usage.
;Normally you should always check if StartTimeCounter() succeeded.
;In this example the timer thread is started and stopped using 0 or default (2) value,
;normally you would start the timer at program start and stop it at program end only.
Define start.l,stop.l,text$
StartTimeCounter(-1) ;A -1 indicate we do not wish to alter system timing.
text$+StrF(GetTimePeriodLatency())+" ms latency before media mode."+#LF$
StopTimeCounter()
StartTimeCounter() ;We'll use 2ms in this example, it is also the default value.
start=GetTimeCount()
text$+StrF(GetTimePeriodLatency())+" ms latency in media mode."+#LF$
stop=GetTimeCount()
StopTimeCounter()
StartTimeCounter(-1)
text$+StrF(GetTimePeriodLatency())+" ms latency after media mode."+#LF$
StopTimeCounter()
text$+#LF$
text$+"It took "+Str(stop-start)+" ms to run the 2nd (in media mode)."
CompilerIf #PB_Compiler_Debugger
EnableDebugger
Debug text$
Debug ""
DisableDebugger
CompilerElse
MessageRequester("Results",text$)
CompilerEndIf
;always get the difference this way as miliseconds since system start actually wraps
;around after 50 days, So in this case we're lucky that signed integer vars is default.
;Windows 9x is supposed to always have 1ms timer resolution?
;NT series seems to have around 10 to 15ms as default.
;On older PC's the system may run a bit slower when media timing is active,
;on a modern PC that is able to run most modern games there should be no issues really.
;Changing the media timer affects the entire system and not just the currently running program
;with games this is no issue obviously, but with multitasking apps this should be taken into consideration
;If a app has requested a media timing higher than 1ms and the system is allready using 1ms timing
;then the app will have 2ms timing despite what the app requested as timing.
;This is done by the OS to avoid that any apps suddenly get reduced timing accuracy.
;Sleep_() and pretty much anything else that uses system timing is affected too
;"Current timers theoretically have a maximum resolution of 1 millisecond and
; an achievable resolution of 2 milliseconds because of performance concerns.
; In addition, existing timers can be up to 1 millisecond late, which means
; the best resolution an application can depend on is 3 milliseconds." - MicroSoft
; http://www.microsoft.com/whdc/system/CEC/mm-timer.mspx
;The reason a thread is used, is to make sure that timer call/poll is only used in one
;place in your entire program. By ensuring this, it can be put in a thread that runs at
;highest priority with minimal overhead. The macro GetTimeCount() which basically is just
;the global var that is set by the thread can be called as many times as you like as it
;is just a global var in you program. The overhead is that of any other normal variable.
;So you can use (or miss-use) GetTimeCount() as often as you like in your program
;with a bare minimum of cpu cycles used. (as it's just a macro that really is a variable)
;Use GetTimeCount() in place of functions like: ElapsedMilliseconds() and
;GetTickCount_() and timeGetTime_() and QueryPerformanceCounter_() and similar.
;Use the GetTimePeriodLatecy() to check latency,
;but please keep in mind the MicroSoft quote further up, only Vista support the new
;High Precision Event Timer (HPET), no plans for XP support. And not all hardware has
;HPET yet, and it is not even mandatory on Vista as far as I noticed,
;so it may not be until Vienna that we can rely fully on QueryPerformanceCounter_().
;But the precision of timeGetTime_() and other functions will be improved as well,
;as old timing methods get remapped/improved to use HPET as a base.
;So in Vienna (and maybe even Vista SP1?) you may be able to set the time peroid to
;1ms (or 0ms?) and get a "constant" latency result of 1ms or 0ms. *crosses fingers*
;*************************** Let's do another example use *********************
DisableDebugger ;Do not remove this or else the loops below will take ages.
Procedure Max2(a.l,b.l)
If a>b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Procedure Min2(a.l,b.l)
If a<b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
StartTimeCounter()
Define l,a.l,b.l,n.l,x.l,y.l
text$=""
a.l=20
b.l=15
n.l=0
start=GetTimeCount()
For n=1 To 100000000
x=Max(a,b)
y=Min(a,b)
Next
stop=GetTimeCount()
text$+"Macro test took "+Str(stop-start)+"ms"+#LF$
n.l=0
start=GetTimeCount()
For n=1 To 100000000
x=Max2(a,b)
y=Min2(a,b)
Next
stop=GetTimeCount()
text$+"Procedure test took "+Str(stop-start)+"ms"+#LF$
CompilerIf #PB_Compiler_Debugger
EnableDebugger
Debug text$
Debug ""
DisableDebugger
CompilerElse
MessageRequester("Results",text$)
CompilerEndIf
StopTimeCounter()
;***************************** Some timer call tests **************************
text$=""
StartTimeCounter()
start=GetTimeCount()
For n=1 To 100000000
ElapsedMilliseconds()
;PureBasics own, not sure what it's based on, it seems to behave like GetTickCount_()?
Next
stop=GetTimeCount()
text$+"ElapsedMilliseconds() test took "+Str(stop-start)+"ms"+#LF$
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
;{ Windows spesific tests
start=GetTimeCount()
For n=1 To 100000000
GetTickCount_()
;Very fast, but not accurate at all, around 15ms latency in my tests
Next
stop=GetTimeCount()
text$+"GetTickCount_() test took "+Str(stop-start)+"ms"+#LF$
start=GetTimeCount()
For n=1 To 100000000
timeGetTime_()
;The fallback I choose if QPC can not be relied on.
;If timeBeginPeriod_() is used this can have a latency down to 2ms
Next
stop=GetTimeCount()
text$+"timeGetTime_() test took "+Str(stop-start)+"ms"+#LF$
Define dummy.q
start=GetTimeCount()
For n=1 To 100000 ;We're kinda cheating here, *100 added to result as QPC is very slow.
QueryPerformanceCounter_(@dummy)
Next
stop=GetTimeCount()
text$+"QueryPerformanceCounter_() test took ~"+Str((stop-start)*100)+"ms"+#LF$
;}
CompilerEndIf
CompilerIf #PB_Compiler_Debugger
EnableDebugger
Debug text$
Debug ""
DisableDebugger
CompilerElse
MessageRequester("Results",text$)
CompilerEndIf
;************************ Full dedicated screen FPS test **********************
text$=""
InitSprite()
SetRefreshRate(85)
OpenScreen(1024,768,32,"test")
;SetFrameRate(100) No effect when fullscreen?
Define i.l
Delay(1000)
text$+"1024x768, 32bit, 85Hz screen."+#LF$+#LF$
i=0
start=GetTimeCount()
Repeat
FlipBuffers(0)
i+1
stop=GetTimeCount()
Until (stop-start)>999
text$+Str(i)+" FlipBuffers, no vblank took "+Str(stop-start)+"ms"+#LF$
i=0
start=GetTimeCount()
Repeat
FlipBuffers(1)
i+1
stop=GetTimeCount()
Until (stop-start)>999
text$+Str(i)+" FlipBuffers, with normal vblank took "+Str(stop-start)+"ms"+#LF$
i=0
start=GetTimeCount()
Repeat
FlipBuffers(2)
i+1
stop=GetTimeCount()
Until (stop-start)>999
text$+Str(i)+" FlipBuffers, CPU friendly vblank took "+Str(stop-start)+"ms"+#LF$
CloseScreen()
CompilerIf #PB_Compiler_Debugger
EnableDebugger
Debug text$
Debug ""
DisableDebugger
CompilerElse
MessageRequester("Results",text$)
CompilerEndIf
StopTimeCounter()
;********************************* That's it for now! *************************
text$="All tests done!"
CompilerIf #PB_Compiler_Debugger
EnableDebugger
Debug text$
Debug ""
DisableDebugger
CompilerElse
MessageRequester("Results",text$)
CompilerEndIfhttp://blogs.msdn.com/oldnewthing/archi ... 59952.aspx
http://www.geisswerks.com/ryan/FAQS/timing.html
