stdVBA

stdVBA copied to clipboard

https://github.com/sancarn/stdVBA/blob/835bf4bece848b48c729211816e3b757bf8b1996/src/stdPerformance.cls#L67-L79

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.

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 👍

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.