timeGetTime で時間を待つのは予想よりも奥が深かった

VBA

まあ，ここを見たんだけど，
イベントを受付つつ待機したい場合，timeGetTime を使って経過時間が過ぎるまで
DoEvents でイベント処理しつつ，待機するって方法があるんだけど，
この timeGetTime にちょいと癖があるって話。（この関数に限らないけどね。。。）


timeGetTime の戻り値はDWORD つまり 0 〜 2 ^ 32 - 1 だけど，
VBAだとLong つまり -2 ^ 31 〜 2 ^ 31 - 1 となり，範囲が異なり，
timeGetTime の戻り値が 2 ^ 31 - 1 を超えたと時にオーバーフローし，-2 ^ 31となる。

# まあ，用途によるけどVBAじゃなくてもtimeGetTime を使う場合は，
# 2 ^ 32 - 1 → 0 に戻ることを考慮すべきだとは思うけどね。


具体的には次のコードでオーバーフローすると無限ループになる。

Sub timeWaitTime(ByVal waitTime As Long)
  Dim startTime As Long
  Dim now As Long
  startTime = timeGetTime  '計測開始時間
  Do
    now = timeGetTime
    If now - startTime >= waitTime Then
      Exit Do
    End If
    Call Sleep(1)
    DoEvents
  Loop
End Sub

だから，上記のページにはオーバーフロー対策について書いてあった。
が，よく見るとDoubleを使ったり，timeGetTimeのラッパーを使ったりして気持ち悪いｗ
なので，ちょっと改良できないか考えてみた。
（これがちょっといい頭の体操になったので書いているわけだがｗ）

改良その１

まず，各変数の範囲を考える。

項目 変数名 型 範囲 備考
開始時刻 startTime Long [-2 ^ 31, 2 ^ 31 - 1] 開始時のtimeGetTimeの戻り値
待ち時間 waitTime Long [0, 2 ^ 31 - 1] 負の時間を待たないから最小値は0
現在時刻 now Long [-2 ^ 31, 2 ^ 31 - 1] 現在のtimeGetTimeの戻り値

次にオーバーフローが起きる場合とそうじゃない場合の場合わけをする。

startTimeの範囲(条件) waitTimeの範囲(条件) now(startTime + waitTime)の範囲 オーバーフローの有無
[-2 ^ 31, 0] [0, 2 ^ 31 - 1] [-2 ^ 31, 2 ^ 31 - 1] 無
(0, 2 ^ 31 - 1] [0, 2 ^ 31 - 1 - startTime] (0, 2 ^ 31 - 1] 無
(0, 2 ^ 31 - 1] (2 ^ 31 - 1 - startTime, 2 ^ 31 - 1] (2 ^ 31 - 1, 2 ^ 31 - 1 + 2 ^ 31 - 1] 有

なので，オーバーフローする最後の場合だけを考えることにする。


ところで，オーバーフローが起きた場合次の関係式が成り立つ。

(2 ^ 31 - 1) + 1 = 2 ^ 31 = -2 ^ 31 (オーバーフローで負になる)

この関係式をnowの範囲に適応すると

(2 ^ 31 - 1, 2 ^ 31 - 1 + 2 ^ 31 - 1] = (-2 ^ 31 - 1, -2] = [-2 ^ 31, -2]

となり，また次の式にも適応すると

startTime = 2 ^ 31 - 1 - x = -2 ^ 31 - 1 - x

となる。


ここで，上記式を用いて，オーバーフローにより期待通り動かない
now - startTime >= waitTime の条件文をオーバーフローしないように変形すると

now - startTime = now - (-2 ^ 31 - 1 - x) >= waitTime
now - (-2 ^ 31) >= waitTime - 1 - x
now - (-2 ^ 31) >= waitTime - x - 1 = waitTime + (startTime + -2 ^ 31)

となり，now - (-2 ^ 31) の範囲は

[-2 ^ 31 - (-2 ^ 31), -2 - (-2 ^ 31)] = [0, 2 ^ 31 - 1 -1]

waitTime + (startTime + -2 ^ 31) の範囲は

(2 ^ 31 - 1 - startTime + (startTime + -2 ^ 31), 2 ^ 31 - 1 + (startTime + -2 ^ 31)]
= (-1, startTime - 1] = (-1, 2 ^ 31 - 1 - 1] = [0, 2 ^ 31 - 1 - 1]

で，オーバーフローもしないことが分かる。

よって，オーバーフローが起きた場合は上記条件文に変更すればよいことになる。それをしたのが次のコード。

Sub timeWaitTime(ByVal waitTime As Long)
  Dim startTime As Long
  Dim now As Long
  startTime = timeGetTime  '計測開始時間
  Do
    now = timeGetTime
    If now < startTime Then
      ' オーバーフォロー処理
      waitTime = waitTime + (startTime + &H80000000)
      startTime = &H80000000
    End If
    If now - startTime >= waitTime Then
      Exit Do
    End If
    Call Sleep(1)
    DoEvents
  Loop
End Sub

改良その２(のはずが)

折角場合わけをしたので，それを反映したバージョンも作ってみた。が！

Private Sub timeWaitTime_new(ByVal waitTime As Long)
    Dim waitTime2 As Long
    Dim startTime As Long
    
    startTime = timeGetTime '計測開始時間
    
    ' startTime <= 0 ならオーバーフローしない
    If startTime > 0 Then
    
        ' startTime + waitTime <= &H7FFFFFFF ならオーバーフローしない
        waitTime2 = waitTime + (startTime + &H80000000)
        ' waitTime2 > -1 と書くべきだが，見た目重視で条件文を変形
        If waitTime2 >= 0 Then
            ' オーバーフローした後にどれだけ待つかを計算
            waitTime2 = waitTime2 + &H80000000

            ' オーバーフローするまで待つ
            Do While timeGetTime > 0
                Call Sleep(1)
                DoEvents
            Loop

            ' オーバーフローしてから待つ
            Do While timeGetTime < waitTime2
                Call Sleep(1)
                DoEvents
            Loop
            Exit Sub
        End If
    End If
    
    ' オーバーフローしないので普通に待つ
    Do While timeGetTime - startTime < waitTime
        Call Sleep(1)
        DoEvents
    Loop
End Sub

実はオーバーフローすることがあって，それはオーバーフローするか否かを判定するときは否であっても，
判定直後にすでにwaitTime 以上過ぎてしまったり，DoEventsの処理中にwaitTime 以上過ぎたりする場合である。
まあ，やる前に気づけよって話だが。


ちなみに，テストにはこんなコード用意してみた。

#include <windows.h>
#include <mmsystem.h>
#pragma comment(lib, "winmm.lib")

static DWORD g_dwBase;

BOOL WINAPI DllMain( HINSTANCE hDLL, DWORD dwReason, LPVOID lpReserved)
{
	return TRUE;
}

__declspec(dllexport) VOID WINAPI setBase(DWORD dwBase)
{
	g_dwBase = dwBase;
}

__declspec(dllexport) DWORD WINAPI getTime()
{
	return g_dwBase + timeGetTime();
}

Declare Function setBase Lib "timeGetTime.dll" (ByVal dwBase As Long) As Long
Declare Function timeGetTime Lib "timeGetTime.dll" Alias "getTime" () As Long
Private Declare Function timeGetTime_org Lib "winmm.dll" Alias "timeGetTime" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub timeWaitTime_test()
    Call setBase(&H7FFFFFFF - timeGetTime_org - 30)
    'Call setBase(-timeGetTime_org - 300)
    
    Call timeWaitTime(20)
End Sub