'===========================================================
' High-Performance Bitwise Shift Operations for 32-bit Integers in Vba
' Implements logical left shift (SHL), logical right shift (SHR),
' and arithmetic right shift (SAR) with optimized routines.
' 2025 coded by isaku@pb4.so-net.ne.jp
'===========================================================

Option Explicit

' Fast logical left shift: shifts bits left by 's' positions.
' Assumes 's' is in the range [1..30].
Public Function FastSHL&(ByVal a&, ByVal s As Byte)
    Dim sign&
    sign = 2& ^ (31 - s)
    FastSHL = (a And (sign - 1)) * (2& ^ s)
    If (a And sign) = sign Then FastSHL = FastSHL Or &H80000000
End Function

' Fast logical right shift: shifts bits right by 's' positions.
' Assumes 's' is in the range [1..30].
' Handles both positive and negative values.
Public Function FastSHR&(ByVal a&, ByVal s As Byte)
    If a >= 0 Then
        FastSHR = a \ (2& ^ s)
    Else
        FastSHR = ((a And &H7FFFFFFF) \ (2& ^ s)) Or (2& ^ (31 - s))
    End If
End Function

' Fast arithmetic right shift: preserves sign bit for negative values.
' Assumes 's' is in the range [1..30].
Public Function FastSAR&(ByVal a&, ByVal s As Byte)
    FastSAR = a \ (2& ^ s)
    If a < 0 And a Mod (2& ^ s) <> 0 Then FastSAR = FastSAR - 1
End Function

' Logical left shift with input validation and edge case handling.
Public Function SHL&(ByVal a&, ByVal s As Byte)
    s = s And 31 ' Mask to [0..31]; comment out if strict range not needed.
    If s = 0 Then SHL = a: Exit Function
    If s > 31 Then SHL = 0: Exit Function
    If s = 31 Then
        If (a And 1) = 1 Then SHL = &H80000000 Else SHL = 0
        Exit Function
    End If
    SHL = FastSHL(a, s)
End Function

' Logical right shift with input validation and edge case handling.
Public Function SHR&(ByVal a&, ByVal s As Byte)
    s = s And 31 ' Mask to [0..31]; comment out if strict range not needed.
    If s = 0 Then SHR = a: Exit Function
    If s = 31 And a < 0 Then SHR = 1: Exit Function
    If s >= 31 Then SHR = 0: Exit Function
    SHR = FastSHR(a, s)
End Function

' Arithmetic right shift with input validation and edge case handling.
Public Function SAR&(ByVal a&, ByVal s As Byte)
    s = s And 31 ' Mask to [0..31]; comment out if strict range not needed.
    If s = 0 Then SAR = a: Exit Function
    If s >= 31 And a < 0 Then SAR = -1: Exit Function
    If s >= 31 Then SAR = 0: Exit Function
    SAR = FastSAR(a, s)
End Function