VBScript で高速にビットシフト演算する (unibon)

左シフト用は sl という Function で、右シフト用は sr という Function です。右シフトは、算術ではなく論理シフトであり、上位ビットには 0 が入ります。
いずれの Function も引数 x がシフトの対象となる値を指定し、引数 n にはシフトするビット数を指定します。
引数の範囲としては、引数 x は Long 型(すなわち &H80000000(= -2147483648) <= x <= &H7FFFFFFF(= 2147483647))の値を指定してください。引数 n は 0 <= n < 32 までです。

おまけとして桁あふれを無視する加算のルーチン(add)も作成しました。
こちらも引数 a および b は Long 型の値を受け付け、a + b の結果を Function の戻り値として Long 型で返します。

いずれも短いプログラムですがオーバフローを回避するために、いろいろと苦心しました。
add のほうは、なまじ Long 型でビット演算をやるよりも一時変数として Currency 型(CCur 関数) を使った方が短いし速かったのですが、あえて Long の範囲内での演算にこだわってみました。
Currency 型(CCur 関数)を使ったバージョンもとりあえず掲載します。これは addCur という Function であり、引数や戻り値は add と同様に Long 型です。

これらの Function は VBScript だけでなく VB(Visual Basic) でも動きます。

Function sl(ByVal x, ByVal n) ' 左シフト
    If n = 0 Then
        sl = x
    Else
        Dim k
        k = CLng(2 ^ (32 - n - 1))
        Dim d
        d = x And (k - 1)
        Dim c
        c = d * CLng(2 ^ n)
        If x And k Then
            c = c Or &H80000000
        End If
        sl = c
    End If
End Function

Function sr(ByVal x, ByVal n) ' 右シフト(算術(>>)ではなく論理(>>>)シフトに相当)
    If n = 0 Then
        sr = x
    Else
        Dim y
        y = x And &H7FFFFFFF
        Dim z
        If n = 32 - 1 Then
            z = 0
        Else
            z = y \ CLng(2 ^ n)
        End If
        If y <> x Then
            z = z Or CLng(2 ^ (32 - n - 1))
        End If
        sr = z
    End If
End Function

Function add(ByVal a, ByVal b) ' オーバフローを無視して 32 ビットの加算をおこなう。
    If a >= 0 And b <= 0 Then
        add = a + b
    ElseIf a <= 0 And b >= 0 Then
        add = a + b
    Else
        Dim x
        x = a And &H3FFFFFFF
        Dim y
        y = b And &H3FFFFFFF
        Dim z
        z = x + y
        Dim f
        f = 0
        If z And &H40000000 Then
            f = f + 1
        End If
        z = z And &H3FFFFFFF
        If a And &H40000000 Then
            f = f + 1
        End If
        If a And &H80000000 Then
            f = f + 2
        End If
        If b And &H40000000 Then
            f = f + 1
        End If
        If b And &H80000000 Then
            f = f + 2
        End If
        If f And 1 Then
            z = z Or &H40000000
        End If
        If f And 2 Then
            z = z Or &H80000000
        End If
        add = z
    End If
End Function

Function addCur(ByVal a, ByVal b) ' オーバフローを無視して 32 ビットの加算をおこなう。
    Dim c
    c = CCur(a) + CCur(b)
    If c > &H7FFFFFFF Then
        c = c - CCur(2 ^ 32)
    ElseIf c < &H80000000 Then
        c = c + CCur(2 ^ 32)
    End If
    addCur = CLng(c)
End Function