High resolution replacement for Sleep

[David Roberts]

Revised SleepXX

This version includes code written by Stuart McLachlan to determine CPUBaseFreq programmatically.

So we now have our machine doing the 'dirty work'.

Code:

#COMPILE EXE
#DIM ALL
#break on
#INCLUDE "win32api.inc"

' SOURCE CODE:

Macro SetHiRes
  MacroTemp Time
  Dim Time As TIMECAPS
  TimeGetDevCaps( Time, SizeOf(Time) )
  TimeBeginPeriod(Time.wPeriodMin)
  'Sleep 16 ' Pre Windows 10
End Macro

Macro RevokeHiRes
  MacroTemp Time
  Dim Time As TIMECAPS
  TimeGetDevCaps( Time, SizeOf(Time) )
  TimeEndPeriod(Time.wPeriodMin)
End Macro

GLOBAL CPUBaseFreq AS QUAD

FUNCTION GetBaseCPUFreq() AS QUAD ' By Stuart McLachlan
  LOCAL retval , hkey AS DWORD
  LOCAL MHz AS DWORD
  retval = RegOpenKeyEx( %HKEY_LOCAL_MACHINE,"HARDWARE\DESCRIPTION\System\CentralProcessor\0"  ,0,%key_query_value,hkey)
  retval = regqueryvalueex(hkey,"~Mhz",0,%REG_DWORD,MHZ,4)
  retval = regclosekey(hkey)
  FUNCTION = MHZ * 10 ^6
END FUNCTION

Sub SleepXX( ByVal n As Double )
  Local qTarget, qTimeNow As Quad
  Tix qTimeNow
  qTarget = qTimeNow + n*CPUBaseFreq*0.001
  If n <= 3 then
    Do : Tix qTimeNow : Loop Until qTimeNow >= qTarget ' Class A amplifier analogy
  Else
    ' Class B amplifier analogy followed by Classs A amplifier analogy
    Sleep ( n-3 ) : Do : Tix qTimeNow  : Loop Until qTimeNow >= qTarget
  End If
End Sub

' ====================

' EXAMPLE USAGE:

FUNCTION PBMAIN () AS LONG
Local i as Long
Local qTime As Quad

  CPUBaseFreq = GetBaseCPUFreq
 
  SetHiRes

  Tix qTime
    SleepXX(0.25)
  Tix End qTime
  Print "Quarter of a millisecond:";format$(qTime/CPUBaseFreq*10^3," ####.######");" ms"
  Print

  Tix qTime
    SleepXX(2000)
  Tix End qTime
  Print "2 seconds:";Format$(qTime/CPUBaseFreq*10^3, "####.######");" ms"
  Print

  Tix qTime
    SleepXX(1234)
  Tix End qTime
  Print "Silly:";ForMat$(qTime/CPUBaseFreq*10^3, "####.######");" ms"
  Print

  For i = 1 to 30
    Tix qTime
      SleepXX(i)
    Tix End qTime
    Print i;" ";Format$(qTime/CPUBaseFreq*10^3, "####.######");" ms"
  Next 

  RevokeHiRes

  WaitKey$

END FUNCTION