array shifter - Printable Version

Code: (Select All)
_Title "array-shifter"

$NoPrefix

$Console:Only

Dest Console



Option Explicit

Dim As _Unsigned Long n(2), k

Dim As Long i, ln

Dim As String s



Print "we first shift the array left and then right from 1 to 16"

Print "notice that 0's are shifted in on the left because we shift left then right"

Print "the top row-pair is the original for comparison"

Print "press return to start"

Sleep

For i = 1 To 16

    n(0) = &B11111111111111111010101010101010

    n(1) = &B10101010101010101010101010101010

    n(2) = &B10101010101010111111111111111111



    k = i

    s = _Bin$(n(0)) + _Bin$(n(1)) + _Bin$(n(2))

    ln = (UBound(n) + 1) * 32

    If Len(s) < ln Then

        s = String$(ln - Len(s), "0") + s

    End If

    Print s

    shiftl n(), k

    shiftr n(), k

    s = _Bin$(n(0)) + _Bin$(n(1)) + _Bin$(n(2))

    If Len(s) < ln Then

        s = String$(ln - Len(s), "0") + s

    End If

    Print s



    Print

Next

Print "press return to continue"

Sleep

Cls

Print "we first shift the array right and then left from 1 to 16"

Print "notice that 0's are shifted in on the right because we shift right then left"

Print "the top row-pair is the original for comparison"

Print "press return to start"

Sleep

For i = 1 To 16

    n(0) = &B11111111111111111010101010101010

    n(1) = &B10101010101010101010101010101010

    n(2) = &B10101010101010111111111111111111



    k = i

    s = _Bin$(n(0)) + _Bin$(n(1)) + _Bin$(n(2))

    If Len(s) < ln Then

        s = s + String$(ln - Len(s), "0")

    End If

    Print s

    shiftr n(), k

    shiftl n(), k

    s = _Bin$(n(0)) + _Bin$(n(1)) + _Bin$(n(2))

    If Len(s) < ln Then

        s = s + String$(ln - Len(s), "0")

    End If

    Print s

    Print

Next

Print "press return to exit"



Function shl32~& (n As _Unsigned Long, k As _Unsigned _Byte, c As _Unsigned Long)

    If k > 0 And k < 32 Then

        Dim As _Unsigned Long carry: carry = n

        Dim As _Unsigned _Byte k32: k32 = 32 - k

        carry = _ShR(carry, k32)

        n = ShL(n, k)

        c = carry

    End If

    shl32~& = n

End Function



Function shr32~& (n As _Unsigned Long, k As _Unsigned _Byte, c As _Unsigned Long)

    If k > 0 And k < 32 Then

        Dim As _Unsigned Long carry: carry = n

        Dim As _Unsigned _Byte k32: k32 = 32 - k

        carry = _ShL(carry, k32)

        n = _ShR(n, k)

        c = carry

    End If

    shr32~& = n

End Function



Sub shiftl (n() As _Unsigned Long, k As Long)

    Dim As Long i, ub: ub = UBound(n)

    Dim As _Unsigned Long carry, c: c = 0

    If k > 0 And k < 32 Then

        For i = ub To 0 Step -1

            n(i) = shl32(n(i), k, carry) + c

            c = carry

        Next

    ElseIf k = 32 Then

        For i = 0 To ub - 1

            n(i) = n(i + 1)

        Next

        n(ub) = 0

    End If

End Sub



Sub shiftr (n() As _Unsigned Long, k As Long)

    Dim As Long i, ub: ub = UBound(n)

    Dim As _Unsigned Long carry, c: c = 0

    If k > 0 And k < 32 Then

        For i = 0 To ub

            n(i) = c + shr32(n(i), k, carry)

            c = carry

        Next

    ElseIf k = 32 Then

        For i = ub To 1 Step -1

            n(i) = n(i - 1)

        Next

        n(0) = 0

    End If

End Sub