VFP BIT* functions

atlopes · Post by **atlopes** » Wed Apr 07, 2021 10:24 pm

This is a kind of a by-product of another thread of the forum. The VFP BIT* functions were briefly discussed as an example of incomplete implementation by the VFP Toolkit for .Net. One of the key aspects that were missing was support for Binary strings.

This is a proposal of an X# implementation of all BIT* functions, accepting both Int and Binary modes when needed, and USUAL parameters as well. Possibly not on the top of the list of anyone looking for X# implementation of VFP functions, but hopefully it has the merit of illustration.

The code is separated into groups, to facilitate the reading and (eventually) the discussion. Some testing is provided in the final. Nevertheless, sorry for being a bit long.

BITAND, OR and XOR

Code: Select all

FUNCTION BITAND (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN _BITANDORX(c'A', Arg1, Arg2)
END FUNC

FUNCTION BITAND (Arg1 AS Int, Arg2 PARAMS Int[]) AS Int
    RETURN _BITANDORX(c'A', Arg1, Arg2)
END FUNC

FUNCTION BITAND (Arg1 AS Binary, Arg2 PARAMS Binary[]) AS Binary
    RETURN _BITANDORX(c'A', Arg1, Arg2)
END FUNC

FUNCTION BITOR (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN _BITANDORX(c'O', Arg1, Arg2)
END FUNC

FUNCTION BITOR (Arg1 AS Int, Arg2 PARAMS Int[]) AS Int
    RETURN _BITANDORX(c'O', Arg1, Arg2)
END FUNC

FUNCTION BITOR (Arg1 AS Binary, Arg2 PARAMS Binary[]) AS Binary
    RETURN _BITANDORX(c'O', Arg1, Arg2)
END FUNC

FUNCTION BITXOR (Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL
    RETURN _BITANDORX(c'X', Arg1, Arg2)
END FUNC

FUNCTION BITXOR (Arg1 AS Int, Arg2 PARAMS Int[]) AS Int
    RETURN _BITANDORX(c'X', Arg1, Arg2)
END FUNC

FUNCTION BITXOR (Arg1 AS Binary, Arg2 PARAMS Binary[]) AS Binary
    RETURN _BITANDORX(c'X', Arg1, Arg2)
END FUNC

STATIC FUNCTION _BITANDORX (LogicalOp AS Char, Arg1 AS USUAL, Arg2 PARAMS USUAL[]) AS USUAL

    IF VARTYPE(Arg1) == "Q"
        VAR Args = Binary[]{Arg2.Length}
        LOCAL ArgIndex AS Int
        
        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (Binary)Arg2[ArgIndex]
        NEXT
        
        RETURN _BITANDORX(LogicalOp, (Binary)Arg1, Args)
    ELSE
        VAR Args = Int[]{Arg2.Length}
        LOCAL ArgIndex AS Int
        
        FOR ArgIndex := 1 TO Args.Length
            Args[ArgIndex] := (Int)Arg2[ArgIndex]
        NEXT
        
        RETURN _BITANDORX(LogicalOp, (Int)Arg1, Args)
    ENDIF
END FUNC

STATIC FUNCTION _BITANDORX (LogicalOp AS Char, Arg1 AS Int, Arg2 PARAMS Int[]) AS Int

    LOCAL Result := Arg1 AS Int
    LOCAL ArgIndex AS Int

    SWITCH LogicalOp
        CASE c'A'
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _And(Result, Arg2[ArgIndex])
            NEXT
        CASE c'O'
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _Or(Result, Arg2[ArgIndex])
            NEXT
        CASE c'X'
            FOR ArgIndex := 1 TO Arg2.Length
                Result := _Xor(Result, Arg2[ArgIndex])
            NEXT
        END

    RETURN Result

END FUNC

STATIC FUNCTION _BITANDORX (LogicalOp AS Char, Arg1 AS Binary, Arg2 PARAMS Binary[]) AS Binary

    LOCAL Result := 0h + Arg1 AS Byte[]
    LOCAL ArgIndex AS Int

    FOR ArgIndex := 1 TO Arg2.Length
        LOCAL Arg := 0h + Arg2[ArgIndex] AS Byte[]
        IF Result.Length < Arg.Length
            Array.Resize(Result, Arg.Length)
        ELSE
            IF Result.Length > Arg.Length
                Array.Resize(Arg, Result.Length)
            ENDIF
        ENDIF
        LOCAL ByteIndex AS Int
        SWITCH LogicalOp
            CASE c'A'
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _And(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE c'O'
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _Or(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            CASE c'X'
                FOR ByteIndex := 1 TO Result.Length
                    Result[ByteIndex] := _Xor(Result[ByteIndex], Arg[ByteIndex])
                NEXT
            END

    ENDFOR
        
    RETURN (Binary)Result

END FUNC

BITNOT

Code: Select all

FUNCTION BITNOT (Arg1 AS USUAL) AS USUAL

    IF VARTYPE(Arg1) == "Q"
        RETURN BITNOT((Binary)Arg1)
    ELSE
        RETURN BITNOT((Int)Arg1)
    ENDIF

END FUNC

FUNCTION BITNOT (Arg1 AS USUAL, Arg2 AS USUAL, Arg3 := 1 AS USUAL) AS Binary

    IF VARTYPE(Arg1) == "Q"
        RETURN BITNOT((Binary)Arg1, (Int)Arg2, (Int)Arg3)
    ELSE
        THROW ArgumentException {}
    ENDIF

END FUNC

FUNCTION BITNOT (Num AS Int) AS Int

    RETURN ~Num

END FUNC

FUNCTION BITNOT (BinString AS Binary) AS Binary

    RETURN BITNOT(BinString, 0, BinString.Length * 8)

END FUNC

FUNCTION BITNOT (BinString AS Binary, StartBit AS Int, BitCount := 1 AS Int) AS Binary

    LOCAL Result := 0h + BinString AS Byte[]
    LOCAL ByteIndex AS Int
    LOCAL BitIndex := StartBit AS Int
    LOCAL BitCounter AS Int

    FOR BitCounter := 1 TO BitCount
        
        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _Xor(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW ArgumentException {}
        ENDIF

    NEXT

    RETURN (Binary)Result

END FUNC

BITCLEAR and BITSET

Code: Select all

FUNCTION BITCLEAR (Arg1 AS USUAL) AS Binary

    RETURN BITCLEAR((Binary)Arg1)

END FUNC

FUNCTION BITCLEAR (Arg1 AS USUAL, Arg2 AS USUAL) AS USUAL

    IF VARTYPE(Arg1) == "Q"
        RETURN IIF(Arg1.Length == 0, 0h, BITCLEAR((Binary)Arg1, (Int)Arg2, 1))
    ELSE
        RETURN BITCLEAR((Int)Arg1, (Int)Arg2)
    ENDIF

END FUNC

FUNCTION BITCLEAR (Arg1 AS USUAL, Arg2 AS USUAL, Arg3 AS USUAL) AS Binary

    RETURN BITCLEAR((Binary)Arg1, (Int)Arg2, (Int)Arg3)

END FUNC

FUNCTION BITCLEAR (Num AS Int, Bit AS Int) AS Int

    IF BETWEEN(Bit, 0, 31)
        RETURN _And(Num, _Not(1 << Bit))
    ELSE
        THROW ArgumentException {}
    ENDIF

END FUNC

FUNCTION BITCLEAR (BinString AS Binary) AS Binary

    RETURN IIF(BinString.Length == 0, 0h, BITCLEAR(BinString, 0, BinString.Length * 8))

END FUNC

FUNCTION BITCLEAR (BinString AS Binary, StartBit AS Int) AS Binary

    RETURN IIF(BinString.Length == 0, 0h, BITCLEAR(BinString, StartBit, 1))

END FUNC

FUNCTION BITCLEAR (BinString AS Binary, StartBit AS Int, BitCount AS Int) AS Binary

    LOCAL Result := 0h + BinString AS Byte[]
    LOCAL ByteIndex AS Int
    LOCAL BitIndex := StartBit AS Int
    LOCAL BitCounter AS Int

    FOR BitCounter := 1 TO BitCount
        
        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _And(Result[ByteIndex], _Not(1 << BitIndex % 8))
            BitIndex++
        ELSE
            THROW ArgumentException {}
        ENDIF

    NEXT

    RETURN (Binary)Result

END FUNC

FUNCTION BITSET (Arg1 AS USUAL) AS Binary

    RETURN BITSET((Binary)Arg1)

END FUNC

FUNCTION BITSET (Arg1 AS USUAL, Arg2 AS USUAL) AS USUAL

    IF VARTYPE(Arg1) == "Q"
        RETURN BITSET((Binary)Arg1, (Int)Arg2, 1)
    ELSE
        RETURN BITSET((Int)Arg1, (Int)Arg2)
    ENDIF

END FUNC

FUNCTION BITSET (Arg1 AS USUAL, Arg2 AS USUAL, Arg3 AS USUAL) AS Binary

    RETURN BITSET((Binary)Arg1, (Int)Arg2, (Int)Arg3)

END FUNC

FUNCTION BITSET (Num AS Int, Bit AS Int) AS Int

    IF BETWEEN(Bit, 0, 31)
        RETURN _Or(Num, 1 << Bit)
    ELSE
        THROW ArgumentException {}
    ENDIF

END FUNC

FUNCTION BITSET (BinString AS Binary) AS Binary

    RETURN IIF(BinString.Length == 0, 0h, BITSET(BinString, 0, BinString.Length * 8))

END FUNC

FUNCTION BITSET (BinString AS Binary, StartBit AS Int) AS Binary

    RETURN IIF(BinString.Length == 0, 0h, BITSET(BinString, StartBit, 1))

END FUNC

FUNCTION BITSET (BinString AS Binary, StartBit AS Int, BitCount AS Int) AS Binary

    LOCAL Result := 0h + BinString AS Byte[]
    LOCAL ByteIndex AS Int
    LOCAL BitIndex := StartBit AS Int
    LOCAL BitCounter AS Int

    FOR BitCounter := 1 TO BitCount
        
        ByteIndex := BitIndex / 8 + 1
        IF BETWEEN(ByteIndex, 1, Result.Length)
            Result[ByteIndex] := _Or(Result[ByteIndex], 1 << BitIndex % 8)
            BitIndex++
        ELSE
            THROW ArgumentException {}
        ENDIF

    NEXT

    RETURN (Binary)Result

END FUNC

BITTEST

Code: Select all

FUNCTION BITTEST (Arg1 AS USUAL, Arg2 AS USUAL) AS Logic

    IF VARTYPE(Arg1) == "Q"
        RETURN BITTEST((Binary)Arg1, (Int)Arg2)
    ELSE
        RETURN BITTEST((Int)Arg1, (Int)Arg2)
    ENDIF
    
END FUNC

FUNCTION BITTEST (Arg AS Int, Bit AS Int) AS Logic

    IF BETWEEN(Bit, 0, 31)
        RETURN _And(Arg, 1 << Bit) != 0
    ELSE
        THROW ArgumentException {}
    ENDIF
    
END FUNC

FUNCTION BITTEST (Arg AS Binary, Bit AS Int) AS Logic
    
    LOCAL Buff := 0h + Arg AS Byte[]
    
    IF BETWEEN(Bit, 0, Buff.Length * 8 - 1)
        RETURN _And(Buff[Bit / 8 + 1], 1 << Bit % 8) != 0
    ELSE
        THROW ArgumentException {}
    ENDIF

END FUNC

BITRSHIFT and BITLSHIFT

Code: Select all

FUNCTION BITRSHIFT (Arg AS USUAL, Bits AS USUAL) AS Int
    RETURN BITRSHIFT((Int)Arg1, (Int)Bits)
END FUNC

FUNCTION BITLSHIFT (Arg AS USUAL, Bits AS USUAL) AS Int
    RETURN BITLSHIFT((Int)Arg1, (Int)Bits)
END FUNC

FUNCTION BITRSHIFT (Arg AS Int, Bits AS Int) AS Int

    IF BETWEEN(Bits, 0, 31)
        IF !BITTEST(Arg, 31) OR Bits == 0
            RETURN Arg >> Bits
        ELSE
            RETURN BITSET(BITCLEAR(Arg, 31) >> Bits, 31 - Bits)
        ENDIF
    ELSE
        THROW ArgumentException {}
    ENDIF

robert · Post by **robert** » Thu Apr 08, 2021 6:40 am

António,

Thanks, this looks awesome.
We can probably copy and paste all of this directly in the code.
We'll convert the tests in your Start() function to unit tests to make sure that future runtime/compiler changes will not break this.
I hope you don't mind that we will change the UPPERCASE function names to CamelCase (e.g. BitNot) to make the code a bit nicer on the eyes. I know that VFP writes the functions in ALL CAPS but in .Net we don't do that (and so do you in your QuickTest() function).

Robert

Chris · Post by **Chris** » Thu Apr 08, 2021 7:31 am

That's great indeed! Only one comment, instead of using a Char variable to denote the type of logical expression, in .Net we can use an ENUM which is designed for such things:

Code: Select all

ENUM LogicalOp
	MEMBER OpAnd
	MEMBER OpOr
	MEMBER OpXor
END ENUM

so the code can then be changed to something like

Code: Select all

STATIC FUNCTION _BITANDORX (op AS LogicalOp, Arg1 AS INT, Arg2 PARAMS INT[]) AS INT
    SWITCH op
        CASE LogicalOp.OpAnd
...

Also maybe it's a good idea to support also Int64 values in BitSet(), BItTest() etc (only upto 32 bits are supported now)? Or should those be considered only as compatibility functions and should support only the types that VFP supports as well?

robert · Post by **robert** » Thu Apr 08, 2021 7:44 am

Chris, António,
Some other small suggestions:
- use IsBinary() instead of VarType() == "Q" (yes, I added that function it did not exist before)
- make sure the code compiler without late binding. There is a function that uses .Length on the usual parameter.
- 0h + BinString to convert to Byte[] and get a new array is no longer needed.

Robert

Karl-Heinz · Post by **Karl-Heinz** » Thu Apr 08, 2021 10:02 am

Hi Antonio,

great work !

two small changes are required to compile your code.

- both 'Arg1' must be renamed to 'Arg'

Code: Select all

FUNCTION BITRSHIFT (Arg AS USUAL, Bits AS USUAL) AS INT
    RETURN BITRSHIFT((INT)Arg1, (INT)Bits)
END FUNC

FUNCTION BITLSHIFT (Arg AS USUAL, Bits AS USUAL) AS INT
    RETURN BITLSHIFT((INT)Arg1, (INT)Bits)
END FUNC

- Here i see the warning "XS9098: Type 'USUAL' does not have a property 'Length'. This gets resolved to a late bound property access."

Code: Select all

FUNCTION BITCLEAR (Arg1 AS USUAL, Arg2 AS USUAL) AS USUAL

    IF VARTYPE(Arg1) == "Q" 
        RETURN IIF(Arg1.Length == 0, 0h, BITCLEAR((Binary)Arg1, (INT)Arg2, 1))
    ELSE
        RETURN BITCLEAR((INT)Arg1, (INT)Arg2)
    ENDIF

END FUNC

To get rid of the warning i would change the line to:

Code: Select all

        RETURN IIF( ((BINARY) Arg1).Length == 0, 0h, BITCLEAR((Binary)Arg1, (INT)Arg2, 1))

regards
Karl-Heinz

Karl-Heinz · Post by **Karl-Heinz** » Thu Apr 08, 2021 10:18 am

robert wrote:Chris, António,
Some other small suggestions:
- use IsBinary() instead of VarType() == "Q" (yes, I added that function it did not exist before)
- make sure the code compiler without late binding. There is a function that uses .Length on the usual parameter.
- 0h + BinString to convert to Byte[] and get a new array is no longer needed.

Robert

Hi Robert,

wouldn´t it make sence to be able to add underscores to literal binaries ? So something like this compiles

0h_ff_ef_aa

regards
Karl-Heinz

atlopes · Post by **atlopes** » Thu Apr 08, 2021 10:37 am

Robert

I hope you don't mind that we will change the UPPERCASE function names to CamelCase (e.g. BitNot) to make the code a bit nicer on the eyes.

Please feel free to modify the code at will, including its cosmetics.

Your remarks, as Chris's and Karl-Heinz's (thank you all!), are also most welcoming. Bit by bit (a small pun intended), I hope they will help me be more at ease with X#.

Chris · Post by **Chris** » Thu Apr 08, 2021 12:40 pm

atlopes wrote:Bit by bit

g.bunzel@domonet.de · Post by **g.bunzel@domonet.de** » Thu Apr 08, 2021 4:04 pm

Karl-Heinz,

...then I think, all Arg1 should renamed to Arg.

two small changes are required to compile your code.

- both 'Arg1' must be renamed to 'Arg'
FUNCTION BITRSHIFT (Arg AS USUAL, Bits AS USUAL) AS INT
RETURN BITRSHIFT((INT)Arg1, (INT)Bits)
END FUNC

FUNCTION BITLSHIFT (Arg AS USUAL, Bits AS USUAL) AS INT
RETURN BITLSHIFT((INT)Arg1, (INT)Bits)
END FUNC

robert · Post by **robert** » Thu Apr 15, 2021 3:11 pm

Antonio,

I'll include this in the upcoming 2.8 release

Robert

Main menu