Bitwise Helpers for R3C

bitwise.reb

Rebol [
    Title: "Bitwise Helpers"
    Date: 28-Jan-2021
    Author: "Christopher Ross-Gill"
    Type: module
    Name: rgchris.bitwise
    Exports: [shift-binary signed32]
    Notes: {
        * General Purpose BINARY SHIFT function (not optimized)
        * Signed-32 helpers
    }
]

shift-binary: func [
    value [binary!]
    'mode [word!]
    bits [integer!]
    <local> width carry-bits mask next-carry-bits
][
    assert [find [left right logical] mode]

    either mode = 'left [
        while [bits >= 8] [
            bits: me - 8
            append remove value 0
        ]

        carry-bits: 0
        mask: shift (-1 + shift 1 bits) 8 - bits

        if not zero? bits [
            for-back offset tail value [
                next-carry-bits: shift offset/1 and+ mask bits - 8
                offset/1: 255 and+ (shift offset/1 bits) or+ carry-bits
                carry-bits: next-carry-bits
            ]
        ]
    ][
        either any [
            mode = 'logical
            zero? 128 and+ value/1
        ][
            while [bits >= 8] [
                bits: me - 8
                remove back tail insert value 0
            ]

            carry-bits: 0
        ][
            while [bits >= 8] [
                bits: me - 8
                remove back tail insert value 255
            ]

            carry-bits: shift (-1 + shift 1 bits) 8 - bits
        ]

        mask: -1 + shift 1 bits

        if not zero? bits [
            for-next offset value [
                next-carry-bits: shift offset/1 and+ mask 8 - bits
                offset/1: 255 and+ (shift offset/1 negate bits) or+ carry-bits
                carry-bits: next-carry-bits
            ]
        ]
    ]

    value
]

signed32: make object! [
    encode: func [
        value [integer!]
    ][
        enbin [be +/- 4] value
    ]

    decode: func [
        value [binary!]
    ][
        switch length-of value [
            4 [debin [be +/- 4] value]
            3 [debin [be + 3] value]
            2 [debin [be + 2] value]
            1 [debin [be + 1] value]
        ]
    ]

    or: enfix func [
        value-1 [integer!]
        value-2 [integer!]
    ][
        decode ((encode value-1) or+ encode value-2)
    ]

    and: enfix func [
        value-1 [integer!]
        value-2 [integer!]
    ][
        decode ((encode value-1) and+ decode value-2)
    ]

    shift: func [
        value [integer!]
        'mode [word!]
        bits [integer!]
    ][
        decode shift-binary encode value :mode bits
    ]
]