Skip to content

stdPerformance - Timer accuracy #57

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
ThomasG08 opened this issue Jul 17, 2022 · 6 comments
Open

stdPerformance - Timer accuracy #57

ThomasG08 opened this issue Jul 17, 2022 · 6 comments
Labels
enhancement New feature or request good first issue Good for newcomers lib-stdPerformance

Comments

@ThomasG08
Copy link

ThomasG08 commented Jul 17, 2022

#If Mac Then
#If MAC_OFFICE_VERSION >= 15 Then
Private Declare Function GetTickCount Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/MicrosoftOffice.framework/MicrosoftOffice" () As Long
#Else
Private Declare Function GetTickCount Lib "Applications:Microsoft Office 2011:Office:MicrosoftOffice.framework:MicrosoftOffice" () As Long
#End If
#Else ' Win32 or Win64
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If
#End If

The GetTickCount Function is limited to the system timer accuracy, which is usually 10-15ms. An improvement of this accuracy could be achieved by using the API for the CPU-Performancecounter and -frequency.

Example:

#If Mac Then
#ElseIf VBA7 Then
   Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (cyFrequency As Currency) As Long
   Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (cyTickCount As Currency) As Long
#ElseIf VBA6 Then
   Private Declare Function QueryPerformanceFrequency Lib "kernel32" (cyFrequency As Currency) As Long
   Private Declare Function QueryPerformanceCounter Lib "kernel32" (cyTickCount As Currency) As Long
#Else
#End If

Public Function CPUPerformanceCounterMicroSecs() As Variant
   Dim Frequency As Currency, TickCount As Currency
   If QueryPerformanceFrequency(Frequency) = 0 Or QueryPerformanceCounter(TickCount) = 0 Then Exit Function
   CPUPerformanceCounterMicroSecs = (CDec(TickCount) / CDec(Frequency)) * 1000000
End Function
Public Function CPUPerformanceCounterFrequency() As Variant
   Dim Frequency As Currency
   If QueryPerformanceFrequency(Frequency) = 0 Then Exit Function
   CPUPerformanceCounterFrequency = Frequency * 1000
End Function

Private Sub TestPerformanceCounter()
  
  Dim i As Long, exp As Long, total As Double, start As Double
  
  For exp = 4 To 7
    start = CPUPerformanceCounterMicroSecs
    For i = 1 To (10 ^ exp)
      total = total + i
    Next i
    Debug.Print (10 ^ exp) & " items - total: " & total & " - Runtime: " & (CPUPerformanceCounterMicroSecs - start) & " µs"
  Next exp
  
End Sub

Running TestPerformanceCounter will give a result similar to this:
10000 items - total: 50005000 - Runtime: 256,7 µs
100000 items - total: 5050055000 - Runtime: 1506,1 µs
1000000 items - total: 505050555000 - Runtime: 14867,8 µs
10000000 items - total: 50505055555000 - Runtime: 148550,2 µs

Edit: the variables for the QueryPerformanceCounter are passed in as currency, as the API-function requires a 64-bit Integer (LongLong) pointer, which is not available in VBA6. VBA6 supports the Currency Datatype, which is a 64-bit Integer with fixed comma. From VBA7 on, the LongLong Type could be used instead.

@sancarn
Copy link
Owner

sancarn commented Jul 21, 2022

Thanks for the example :)

The only issue I do see is Mac compatibility. I don't think such a function exists on Mac OS, so will have to keep old functionality in the rework I imagine. I did consider this at the time, but wasnt totally sure whether it's worth the hassle of adding a different implementation for what is likely a minor improvement in speed tests. In the end:

  • VBA already takes varying times to call DLL functions depending on computer/system
  • stdPerformance already relies on garbage collection to read the end time, which may lead to randomness.

Happy to accept a PR for this 👍

@sancarn sancarn added enhancement New feature or request good first issue Good for newcomers labels Jul 21, 2022
@ThomasG08
Copy link
Author

Thank you for the feedback.
I will do some digging on equivalent functions on Mac and will do some digging into what randomness is introduced due to garbage collection. In the end you might probably be right - if it's so important to measure sub-millisecond runtimes one should not rely on garbage collection anyway to measure the results.
If I find the results still worthwhile, I will come back with a PR.

@psilosynapse
Copy link

Would this be as simple as declaring the high resolution timer as shown above and then inserting a function like this (I multiplied by 1000 to keep the units at ms):

`Public Function QPC() As Variant
Dim Frequency As Currency, TickCount As Currency
If QueryPerformanceFrequency(Frequency) = 0 Or QueryPerformanceCounter(TickCount) = 0 Then Exit Function
QPC = (CDec(TickCount) / CDec(Frequency)) * 1000

End Function`

I made the pStartTime = QPC and pEndtime = QPC in the Initialize and Terminate procedures respectively and it seems to be working.

@sancarn
Copy link
Owner

sancarn commented Dec 14, 2022

@ThomasG08 Looks like the equivalent for mac is mach_absolute_time and mach_timebase_info I'm not certain how to declare these though (yet).

As to garbage collection, looks like VBA doesn't use garbage collection.

but VBA/Excel does not have garbage collection, like old VB. Instead of GC, it uses reference counting. Memory is freed when you set a pointer to nothing (or when variable goes out of scope). Like in old VB it means that circular references are never freed.


@psilosynapse To be fair, yes, though I think I'd prefer to keep backwards compatibility. Also it seems some systems don't even have QPF function:

Public Function QueryTick() As Double
  static Frequency as currency, QPFAvailable: if isEmpty(QPFAbailable) then QPFAvailable = QueryPerformanceFrequency(Frequency) <> 0
  If QPFAvailable Then
    Dim TickCount As Currency
    if QueryPerformanceCounter(TickCount) = 0 then Exit Function 'At what point does this actually occur?
    QueryTick = (CDec(TickCount) / CDec(Frequency)) * 1000
  else
    QueryTick = GetTickCount()
  end if
End Function

@guwidoe
Copy link

guwidoe commented Dec 9, 2023

@sancarn, if you are still interested in this, have a look at the code I use for timing in VBA: VBA-AccurateTimer (gist)

It's implemented fully cross-platform, and with the best possible performance as a goal.
I kept it contained to one standard module for maximum portability, but it could serve you as a handy example for the more elaborate implementation in your library, especially how to use the API functions mach_absolute_time and mach_timebase_info on Mac.
I'm using mach_continuous_time instead of mach_absolute_time but they are interchangeable with the only difference being that mach_absolute_time does not increment while the system is asleep while mach_continuous_time does.

@sancarn
Copy link
Owner

sancarn commented Dec 9, 2023

@sancarn, if you are still interested in this, have a look at the code I use for timing in VBA: VBA-AccurateTimer (gist)

It's implemented fully cross-platform, and with the best possible performance as a goal. I kept it contained to one standard module for maximum portability, but it could serve you as a handy example for the more elaborate implementation in your library, especially how to use the API functions mach_absolute_time and mach_timebase_info on Mac. I'm using mach_continuous_time instead of mach_absolute_time but they are interchangeable with the only difference being that mach_absolute_time does not increment while the system is asleep while mach_continuous_time does.

Ah cool thanks :) Glad it's doable on mac and good to see an implementation 👍 If you want to try your hand at a PR feel free, else I'll add it to my long todo list 😄

@sancarn sancarn added this to Roadmap Jun 3, 2024
@sancarn sancarn moved this to Feature Request/Unknown requirement in Roadmap Jun 3, 2024
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
enhancement New feature or request good first issue Good for newcomers lib-stdPerformance
Projects
Status: Feature Request/Unknown requirement
Development

No branches or pull requests

4 participants