Welcome, Guest |
This public forum is meant for questions and discussions about Visual FoxPro
TOPIC:
VFP BIT* functions 08 Apr 2021 00:24 #17973
|
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 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 FUNCBITNOT 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 FUNCBITCLEAR and BITSET 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 FUNCBITTEST 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 FUNCBITRSHIFT and BITLSHIFT 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
END FUNC
FUNCTION BITLSHIFT (Arg AS Int, Bits AS Int) AS Int
IF BETWEEN(Bits, 0, 31)
RETURN Arg << Bits
ELSE
THROW ArgumentException {}
ENDIF
END FUNCFinnally, some testing (all expected results come from VFP): FUNCTION Start() AS VOID
LOCAL TestNr AS Int
TestNr = 1
QuickTest(TestNr++, 'BITAND(318, 7.5)', BITAND(318, 7.5), 6)
QuickTest(TestNr++, 'BITAND(-838, 0x06AC, 873445)', BITAND(-838, 0x06AC, 873445), 160)
QuickTest(TestNr++, 'BITAND(0h, 0hFFFF)', BITAND(0h, 0hFFFF), 0h0000)
QuickTest(TestNr++, 'BITAND(0h01234567, 0h89abcdef)', BITAND(0h01234567, 0h89abcdef), 0h01234567)
QuickTest(TestNr++, 'BITOR(318, 7.5)', BITOR(318, 7.5), 319)
QuickTest(TestNr++, 'BITOR(-838, 0x06AC, 873445)', BITOR(-838, 0x06AC, 873445), -1)
QuickTest(TestNr++, 'BITOR(0h, 0hFFFF)', BITOR(0h, 0hFFFF), 0hffff)
QuickTest(TestNr++, 'BITOR(0h01234567, 0h89abcdef)', BITOR(0h01234567, 0h89abcdef), 0h89abcdef)
QuickTest(TestNr++, 'BITXOR(318, 7.5)', BITXOR(318, 7.5), 313)
QuickTest(TestNr++, 'BITXOR(-838, 0x06AC, 873445)', BITXOR(-838, 0x06AC, 873445), -873997)
QuickTest(TestNr++, 'BITXOR(0h, 0hFFFF)', BITXOR(0h, 0hFFFF), 0hffff)
QuickTest(TestNr++, 'BITXOR(0h01234567, 0h89abcdef)', BITXOR(0h01234567, 0h89abcdef), 0h88888888)
QuickTest(TestNr++, 'BITNOT(0x01)', BITNOT(0x01), -2)
QuickTest(TestNr++, 'BITNOT(0h)', BITNOT(0h), 0h)
QuickTest(TestNr++, 'BITNOT(0hffff, 7)', BITNOT(0hffff, 7), 0h7fff)
QuickTest(TestNr++, 'BITNOT(0hffff, 7, 4)', BITNOT(0hffff, 7, 4), 0h7ff8)
QuickTest(TestNr++, 'BITCLEAR(0x00abff81, 15)', BITCLEAR(0x00abff81, 15), 11239297)
QuickTest(TestNr++, 'BITCLEAR(0h)', BITCLEAR(0h), 0h)
QuickTest(TestNr++, 'BITCLEAR(0hffff)', BITCLEAR(0hffff), 0h0000)
QuickTest(TestNr++, 'BITCLEAR(0hffff, 0)', BITCLEAR(0hffff, 0), 0hfeff)
QuickTest(TestNr++, 'BITCLEAR(0hffff, 0, 8)', BITCLEAR(0hffff, 0, 8), 0h00ff)
QuickTest(TestNr++, 'BITSET(0x00abff81, 31)', BITSET(0x00abff81, 31), -2136211583)
QuickTest(TestNr++, 'BITSET(0h)', BITSET(0h), 0h)
QuickTest(TestNr++, 'BITSET(0h0000)', BITSET(0h0000), 0hffff)
QuickTest(TestNr++, 'BITSET(0h0000, 2)', BITSET(0h0000, 2), 0h0400)
QuickTest(TestNr++, 'BITSET(0h0000, 2, 8)', BITSET(0h0000, 2, 8), 0hfc03)
QuickTest(TestNr++, 'BITTEST(-1, 0)', BITTEST(-1, 0), .T.)
QuickTest(TestNr++, 'BITTEST(-2, 0)', BITTEST(-2, 0), .F.)
QuickTest(TestNr++, 'BITTEST(0hfffffffff7ffff, 35)', BITTEST(0hfffffffff7ffff, 35), .F.)
QuickTest(TestNr++, 'BITRSHIFT(0xFFFFFFFF, 3)', BITRSHIFT(0xFFFFFFFF, 3), 536870911)
QuickTest(TestNr++, 'BITLSHIFT(536870911, 3)', BITLSHIFT(536870911, 3), -8)
WAIT
RETURN
ENDFUNC
FUNCTION QuickTest (Test AS Int, Expression AS String, Result AS USUAL, Expected AS USUAL) AS Void
? Test, Expression, "->", Result,"vs.", Expected, "(" + IIF(Result == Expected, "Success", "FAIL!") + ")"
ENDFUNC |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 08:40 #17975
|
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 XSharp Development Team The Netherlands |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 09:31 #17976
|
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: ENUM LogicalOp
MEMBER OpAnd
MEMBER OpOr
MEMBER OpXor
END ENUMso the code can then be changed to something like 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? XSharp Development Team chris(at)xsharp.eu |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 09:44 #17977
|
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 XSharp Development Team The Netherlands |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 12:02 #17978
|
Hi Antonio, great work ! 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 FUNCFUNCTION 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 FUNCTo get rid of the warning i would change the line to: RETURN IIF( ((BINARY) Arg1).Length == 0, 0h, BITCLEAR((Binary)Arg1, (INT)Arg2, 1))regards Karl-Heinz |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 12:18 #17979
|
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 |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 12:37 #17981
|
Robert
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#. |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 14:40 #17985
|
 XSharp Development Team chris(at)xsharp.eu |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 08 Apr 2021 18:04 #17986
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 |
Please Log in or Create an account to join the conversation. |
VFP BIT* functions 15 Apr 2021 17:11 #18044
|
Antonio, I'll include this in the upcoming 2.8 release Robert XSharp Development Team The Netherlands |
Please Log in or Create an account to join the conversation. |