by David Qualls (2 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 8th October 2006
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface slightly changed; documentation also improved)
API Declarations
setbit (bitvect() As Long, posn As Long) As Long
clearbit (bitvect() As Long, posn As Long) As Long
togglebit (bitvect() As Long, posn As Long) As Long
' ----- all bits functions -----
bitsClearAll(bitvect() As Long)
bitsSetAll (bitvect() As Long)
bitsOrEq (altered() As Long, source() As Long)
bitsAndEq (altered() As Long, source() As Long)
bitsXorEq (altered() As Long, source() As Long)
bitsCompare (bv1() As Long, bv2() As Long) As Long
bits2string (bitvect() As Long) As String
string2bits (bitvect() As Long, bstr As String) As Long()
' ----- single integer functions -----
promoteSBits(shortValue As Integer) As Long
demoteHighBits(longValue As Long) As Integer
demoteLowBits(longValue As Long) As Integer
' ----- information functions -----
highestbit (bitvect() As Long) As Long
lowestbit (bitvect() As Long) As Long
' ----- test function -----
test_bits()
VBcoders
Option Explicit
' bits: A simple bitvector and bits conversion library. The functions within
' this library allow an array of 32-Bit Ints to be treated as a bit vector.
'
' David Qualls
' [email protected]
' August 2006
'
' Within this file, there are public definitions for:
' - 33 BITx constants (BIT0 thru BIT31 plus NOBITS), all of 32-bit integer type.
' - 4 BYTEx constants (BYTE0 thru BYTE3), all of 32-bit integer type.
' - 17 SBITx constants (SBIT0 thru SBIT15 plus SNOBITS), all of 16-bit (Short)integer type.
' - One 32-bit integer array of single-bit values.
' - One 16-bit integer array of single-bit values.
' - The following functions:
' ----- single bit functions -----
'CAUTION: The single bit functions return either zero, or NON-ZERO.
'They DO NOT normally return 1 (unity). Always test for non-zero;
'never for unity:
'RIGHT: "If _bit() Then"
'WRONG: "If _bit() = 1 Then"
' getbit (bitvect() As Long, posn As Long) As Long
' setbit (bitvect() As Long, posn As Long) As Long
' clearbit (bitvect() As Long, posn As Long) As Long
' togglebit (bitvect() As Long, posn As Long) As Long
' ----- all bits functions -----
' bitsClearAll(bitvect() As Long)
' bitsSetAll (bitvect() As Long)
' bitsOrEq (altered() As Long, source() As Long)
' bitsAndEq (altered() As Long, source() As Long)
' bitsXorEq (altered() As Long, source() As Long)
' bitsCompare (bv1() As Long, bv2() As Long) As Long
' bits2string (bitvect() As Long) As String
' string2bits (bitvect() As Long, bstr As String) As Long()
' ----- single integer functions -----
' promoteSBits(shortValue As Integer) As Long
' demoteHighBits(longValue As Long) As Integer
' demoteLowBits(longValue As Long) As Integer
' ----- information functions -----
' highestbit (bitvect() As Long) As Long
' lowestbit (bitvect() As Long) As Long
' ----- test function -----
' test_bits()
'
' Two private support functions are also defined here:
' bitsBinarySearch_Long(ByVal key As Long, realarray() As Long, ByVal nelem As Long) As Long
' intbits2string(intbit As Long) As String
'
' Prior to using any of these functions, the initialization function
' initializeBits() should (or must, depending on the function) be
' called one time. The bitsInitialized public variable is available to
' test whether the initialization function has been called. By using
' the construct:
' If Not bitsInitialized Then Call initializeBits
' you can prevent re-loading the initialization function frequently.
'
' Bit vectors begin with BIT0, not BIT1. All bits OFF is the constant
' NOBITS. Higher order bits (BIT1 is higher order than BIT0, etc.)
' are numerically more significant (BIT1 > BIT0, etc.) This affects
' the way bitsCompare() works.
'
' There are two requirements of the array of longs passed to any of these
' functions as the bitvect:
' 1: bitvect must not be zero length. Thus, it must be Dimensioned (or
' ReDimensioned) before being passed to the function.
' 2: bitvect must be zero based (the first element must be at index zero).
' And there are two requirements of the 'bit-position' argument:
' 1: posn must not be negative (zero is fine however).
' 2: If bitvect is a static array, posn must never equal or exceed
' 32*(UBound(bitvect)+1) (although getbit() will succeed even if
' posn is too large -- it just returns 0)
'
' Generally, bitvectors automatically expand to accomodate the action being
' taken on them. Only the bit-altering functions (setbit, clearbit,
' togglebit, bitsOrEQ, bitsAndEq, and bitsXorEq, string2bits) automatically
' increase the length of a bit vector. You are also free to alter the length
' yourself with no ill effects.
'
' In a class approach, we would store extra information about the bit array,
' and perhaps dynamically shorten it as appropriate. This however would
' negate the advantages of being able to polymorphically treat an array of
' integers as a bit-vector. To reduce the storage of a bit-vector, use:
' If KeepMyBitVectorsShort = True Then
' ReDim Preserve bitvect(0 To (highestbit(bitvect) \ 32))
' End If
'
Public bitsInitialized As Boolean
Public Const SNOBITS As Integer = 0
Public Const SBIT0 As Integer = 1
Public Const SBIT1 As Integer = SBIT0 * 2
Public Const SBIT2 As Integer = SBIT1 * 2
Public Const SBIT3 As Integer = SBIT2 * 2
Public Const SBIT4 As Integer = SBIT3 * 2
Public Const SBIT5 As Integer = SBIT4 * 2
Public Const SBIT6 As Integer = SBIT5 * 2
Public Const SBIT7 As Integer = SBIT6 * 2
Public Const SBIT8 As Integer = SBIT7 * 2
Public Const SBIT9 As Integer = SBIT8 * 2
Public Const SBIT10 As Integer = SBIT9 * 2
Public Const SBIT11 As Integer = SBIT10 * 2
Public Const SBIT12 As Integer = SBIT11 * 2
Public Const SBIT13 As Integer = SBIT12 * 2
Public Const SBIT14 As Integer = SBIT13 * 2
Public Const SBIT15 As Integer = (Not 0) And (Not _
(SBIT0 Or SBIT1 Or SBIT2 Or SBIT3 Or SBIT4 Or SBIT5 Or SBIT6 Or SBIT7 Or _
SBIT8 Or SBIT9 Or SBIT10 Or SBIT11 Or SBIT12 Or SBIT13 Or SBIT14))
Public Const NOBITS As Long = 0
Public Const BIT0 As Long = 1
Public Const BIT1 As Long = BIT0 * 2
Public Const BIT2 As Long = BIT1 * 2
Public Const BIT3 As Long = BIT2 * 2
Public Const BIT4 As Long = BIT3 * 2
Public Const BIT5 As Long = BIT4 * 2
Public Const BIT6 As Long = BIT5 * 2
Public Const BIT7 As Long = BIT6 * 2
Public Const BIT8 As Long = BIT7 * 2
Public Const BIT9 As Long = BIT8 * 2
Public Const BIT10 As Long = BIT9 * 2
Public Const BIT11 As Long = BIT10 * 2
Public Const BIT12 As Long = BIT11 * 2
Public Const BIT13 As Long = BIT12 * 2
Public Const BIT14 As Long = BIT13 * 2
Public Const BIT15 As Long = BIT14 * 2
Public Const BIT16 As Long = BIT15 * 2
Public Const BIT17 As Long = BIT16 * 2
Public Const BIT18 As Long = BIT17 * 2
Public Const BIT19 As Long = BIT18 * 2
Public Const BIT20 As Long = BIT19 * 2
Public Const BIT21 As Long = BIT20 * 2
Public Const BIT22 As Long = BIT21 * 2
Public Const BIT23 As Long = BIT22 * 2
Public Const BIT24 As Long = BIT23 * 2
Public Const BIT25 As Long = BIT24 * 2
Public Const BIT26 As Long = BIT25 * 2
Public Const BIT27 As Long = BIT26 * 2
Public Const BIT28 As Long = BIT27 * 2
Public Const BIT29 As Long = BIT28 * 2
Public Const BIT30 As Long = BIT29 * 2
Public Const BIT31 As Long = (Not 0) And (Not _
(BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7 Or _
BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15 Or _
BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23 Or _
BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30))
Private Const BITS0thru4 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4
Private Const BITS0thru7 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7
Private Const BITS8thru15 As Long = BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15
Private Const BITS16thru23 As Long = BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23
Private Const BITS24thru31 As Long = BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30 Or BIT31
Public Const BYTE0 As Long = BITS0thru7
Public Const BYTE1 As Long = BITS8thru15
Public Const BYTE2 As Long = BITS16thru23
Public Const BYTE3 As Long = BITS24thru31
Private Const strOne As String = "1"
Public Bits(31) As Long
Public SBits(15) As Integer
Private testbitvect() As Long
Private testbitvect2() As Long
Sub initializeBits()
'{
If bitsInitialized Then Exit Sub
bitsInitialized = True
SBits(0) = SBIT0
SBits(1) = SBIT1
SBits(2) = SBIT2
SBits(3) = SBIT3
SBits(4) = SBIT4
SBits(5) = SBIT5
SBits(6) = SBIT6
SBits(7) = SBIT7
SBits(8) = SBIT8
SBits(9) = SBIT9
SBits(10) = SBIT10
SBits(11) = SBIT11
SBits(12) = SBIT12
SBits(13) = SBIT13
SBits(14) = SBIT14
SBits(15) = SBIT15
Bits(0) = BIT0
Bits(1) = BIT1
Bits(2) = BIT2
Bits(3) = BIT3
Bits(4) = BIT4
Bits(5) = BIT5
Bits(6) = BIT6
Bits(7) = BIT7
Bits(8) = BIT8
Bits(9) = BIT9
Bits(10) = BIT10
Bits(11) = BIT11
Bits(12) = BIT12
Bits(13) = BIT13
Bits(14) = BIT14
Bits(15) = BIT15
Bits(16) = BIT16
Bits(17) = BIT17
Bits(18) = BIT18
Bits(19) = BIT19
Bits(20) = BIT20
Bits(21) = BIT21
Bits(22) = BIT22
Bits(23) = BIT23
Bits(24) = BIT24
Bits(25) = BIT25
Bits(26) = BIT26
Bits(27) = BIT27
Bits(28) = BIT28
Bits(29) = BIT29
Bits(30) = BIT30
Bits(31) = BIT31
'}
End Sub 'initializeBits
Function getbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Returns zero if the indicated bit is off, NON-ZERO if on.
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx <= UBound(bitvect) Then
getbit = bitvect(indx) And Bits(ofst)
Else
getbit = 0
End If
'}
End Function 'getbit
Function setbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Sets indicated bit to one, or ON.
' Returns the ORIGINAL bit status (zero or non-zero).
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then
ReDim Preserve bitvect(0 To indx)
bitvect(indx) = Bits(ofst) ' turn bit on.
setbit = 0 ' previous value was definitely off.
Else
setbit = bitvect(indx) And Bits(ofst) 'get the current bit value
bitvect(indx) = bitvect(indx) Or Bits(ofst) 'turn the bit ON
End If
'}
End Function 'setbit
Function togglebit(bitvect() As Long, ByVal posn As Long) As Long
'{ Toggles the indicated bit. OFF goes to ON, ON goes to OFF.
' Returns the ORIGINAL bit status (zero or non-zero).
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then ' bit is assumed off, need to set it.
ReDim Preserve bitvect(0 To indx)
bitvect(indx) = Bits(ofst) ' was off, so turn it on.
togglebit = 0 ' previous value was definitely off.
Else
togglebit = bitvect(indx) And Bits(ofst) 'get the current bit value
bitvect(indx) = bitvect(indx) Xor Bits(ofst) 'toggle the bit.
End If
'}
End Function 'togglebit
Function clearbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Sets indicated bit to zero, or OFF.
' Returns the ORIGINAL bit status (zero or non-zero).
Dim indx As Long
Dim ofst As Long
indx = posn \ 32 ' Hopefully, basic is smart enough to convert this to posn >> 5
' ofst = posn MOD 32
ofst = posn And BITS0thru4
If indx > UBound(bitvect) Then
ReDim Preserve bitvect(0 To indx)
clearbit = 0 ' previous value was definitely off.
Else
clearbit = bitvect(indx) And Bits(ofst) 'get the current bit value
bitvect(indx) = bitvect(indx) And (Not Bits(ofst)) 'turn the bit OFF
End If
'}
End Function 'clearbit
Function highestbit(bitvect() As Long) As Long
'{ This function returns the most-significant on-bit of bitvect.
' A value of -1 indicates no bits are on.
Dim indx As Long
Dim ofst As Long
Dim bvndx As Long
' Linearly search for the last (highest order) element in bitvect array
' with a non-zero value (at least one bit ON).
indx = UBound(bitvect) + 1
Do While indx <> 0
indx = indx - 1
If bitvect(indx) <> 0 Then Exit Do
Loop
bvndx = bitvect(indx)
If bvndx = 0 Then 'exited naturally from the Do-loop above.
highestbit = -1 'No bits are on.
Exit Function
ElseIf bvndx And BIT31 Then 'the sign bit is on. Would hose the bsearch algorithm!
ofst = 31
Else ' a linear search will require 15.5 comparisons (on average).
' a binary search will require about 3.91 comparisons (on average).
' This difference probably justifies the function call and
' additional overhead of using a binary search.
ofst = bitsBinarySearch_Long(bvndx, Bits, 31) ' don't include BIT31; can cause overflow!
If Bits(ofst) <> bvndx Then ofst = ofst - 1
End If
highestbit = indx * 32 + ofst
'}
End Function 'highestbit
Function lowestbit(bitvect() As Long) As Long
'{ This function returns the least-significant on-bit of bitvect.
' A value of -1 indicates no bits are on.
Dim indx As Long
Dim ofst As Long
Dim bytebit As Long
Dim lval As Long
Dim bmask As Long
' Linearly search for the first (lowest order) element in bitvect array
' with a non-zero value (at least one bit ON).
indx = -1
Do While indx < UBound(bitvect)
indx = indx + 1
If bitvect(indx) <> 0 Then Exit Do
Loop
lval = bitvect(indx)
If lval = 0 Then 'exited naturally from the Loop above.
lowestbit = -1 'No bits are on.
Exit Function
End If
' We have found an INT that has at least one bit on. Locate that bit...
' Begin with a binary search for lowest order byte.
If lval And (BYTE1 Or BYTE0) Then 'bit(s) are on in the low word.
'{
If lval And BYTE0 Then 'bit(s) are on in the low byte.
bmask = BIT0
ofst = 0
Else 'bit(s) must be in the high byte.
bmask = BIT8
ofst = 8
End If
'}
Else 'bit(s) must be in the high word.
'{
If lval And BYTE2 Then 'bit(s) are on in the low byte.
bmask = BIT16
ofst = 16
Else 'bit(s) must be in the high byte.
bmask = BIT24
ofst = 24
End If
'}
End If
' and end with a linear search for lowest order bit within appropriate byte.
For bytebit = 0 To 5 '6 iterations
' If lval And BITS(ofst) Then Goto GOT_OFST ' TOO SLOW. multiplication is faster than array-lookup.
If lval And bmask Then GoTo GOT_OFST 'skip the after-loop section.
bmask = bmask * 2 'would run-time error on iteration 7 if ofst=24!
Next bytebit
' after-loop section. Now bmask == BIT6, OR BIT14, OR BIT22, OR BIT30
If lval And bmask Then '7'th attempt. bmask is already in a register. Use it!
bytebit = 6
Else 'We know it's not zero. Only one possibility left!
bytebit = 7
End If
GOT_OFST:
lowestbit = indx * 32 + ofst + bytebit
'}
End Function 'lowestbit
Function bitsClearAll(bitvect() As Long)
'{
Dim indx As Long
' If For loops can truly run faster than this, then, well, I apologize
' for my thick-headedness. I just can't seem to figure the semantics
' for both USING the index, AND comparing it to zero (which maps directly
' to a "jnz" machine instruction) from within a For-Next loop.
indx = UBound(bitvect) + 1
Do While indx <> 0
indx = indx - 1
bitvect(indx) = NOBITS
Loop
'}
End Function
Function bitsSetAll(bitvect() As Long)
'{
Dim indx As Long
indx = UBound(bitvect) + 1
Do While indx <> 0
indx = indx - 1
bitvect(indx) = Not NOBITS
Loop
'}
End Function
Function bitsCompare(bv1() As Long, bv2() As Long) As Long
'{ Returns: a negative value if bv1 is numerically less than bv2,
' : zero if bv1 is numerically equal to bv2,
' : a positive value if bv1 is numerically greater than bv2,
'
Dim indx1 As Long
Dim indx2 As Long
indx1 = UBound(bv1)
indx2 = UBound(bv2)
Do While indx1 > indx2
If bv1(indx1) <> NOBITS Then 'bv1 > bv2
bitsCompare = 1
Exit Function
End If
indx1 = indx1 - 1
Loop
Do While indx2 > indx1
If bv2(indx2) <> NOBITS Then 'bv2 > bv1
bitsCompare = -1
Exit Function
End If
indx2 = indx2 - 1
Loop
' Now the two indices are equal. Arbitrarily pick indx1 to use.
' Look for the highest order elements that are not equal.
Do
If bv1(indx1) <> bv2(indx1) Then GoTo COMPARE_LONGS
indx1 = indx1 - 1
Loop While indx1 >= 0
' Normal exit: looped thru the entire array, and every element compared equal.
bitsCompare = 0
Exit Function
COMPARE_LONGS:
If (bv1(indx1) And BIT31) Xor (bv2(indx1) And BIT31) Then 'they differ in BIT31
If bv2(indx1) And BIT31 Then 'BIT31 of bv1 must have been OFF.
bitsCompare = -1 'bv2 is greater.
Else 'BIT31 of bv2 is OFF.
bitsCompare = 1 'bv1 is greater.
End If
Exit Function
End If
' Now that the sign bit is handled, the rest is duck-soup since both
' values should be positive. Granted this does ASSUME that 00000 - 01111
' (but with 32 bits, not 5) does not overflow. Works fine in 2's complement.
' If unsure, just use the commented-out stuff INSTEAD OF the last line.
' If bv1(indx1) < bv2(indx1) Then
' bitsCompare = -1
' ElseIf bv1(indx1) > bv2(indx1) Then
' bitsCompare = 1
' Else ' bv1(indx1) == bv2(indx1)
' bitsCompare = 0
' End If
bitsCompare = bv1(indx1) - bv2(indx1)
'}
End Function 'bitsCompare
Function bitsOrEq(bv1() As Long, bv2() As Long)
'{ Bitwise ORs bv1 and bv2 together, and stores the result in bv1
Dim ndx As Long
Dim ub2 As Long
ub2 = UBound(bv2)
If UBound(bv1) < ub2 Then ReDim Preserve bv1(ub2)
'Might benefit from a minlen analysis as in bitsXorEq, but this works.
For ndx = 0 To ub2
bv1(ndx) = bv1(ndx) Or bv2(ndx) 'past minlen is equivalent to: bv1(ndx) = bv2(ndx)
Next ndx
'}
End Function 'bitsOrEq
Function bitsAndEq(bv1() As Long, bv2() As Long)
'{ Bitwise ANDs bv1 and bv2 together, and stores the result in bv1
Dim ndx As Long
Dim minlen As Long 'lesser of the two vector lengths.
Dim ub1 As Long, ub2 As Long
ub1 = UBound(bv1)
ub2 = UBound(bv2)
If ub1 < ub2 Then
minlen = ub1
ReDim Preserve bv1(ub2) 'make bv1 same length as bv2
Else
minlen = ub2
End If
For ndx = 0 To minlen
bv1(ndx) = bv1(ndx) And bv2(ndx)
Next ndx
If ub1 > minlen Then
For ndx = ndx To ub1
bv1(ndx) = NOBITS
Next ndx
End If
'}
End Function 'bitsAndEq
Function bitsXorEq(bv1() As Long, bv2() As Long)
'{ Bitwise XORs bv1 and bv2 together, and stores the result in bv1
Dim ndx As Long
Dim minlen As Long 'lesser of the two vector lengths.
Dim ub1 As Long, ub2 As Long
ub1 = UBound(bv1)
ub2 = UBound(bv2)
If ub1 < ub2 Then
minlen = ub1
ReDim Preserve bv1(ub2) 'make bv1 same length as bv2
Else
minlen = ub2
End If
For ndx = 0 To minlen
bv1(ndx) = bv1(ndx) Xor bv2(ndx)
Next ndx
If ub2 > minlen Then
For ndx = ndx To ub2
bv1(ndx) = bv2(ndx)
Next ndx
End If
'}
End Function 'bitsXorEq
Private Function intbits2string(intbit As Long) As String
'{
Dim i As Long
Dim bmask As Long
intbits2string = "00000000000000000000000000000000"
bmask = BIT0
For i = 32 To 3 Step -1
If intbit And bmask Then Mid(intbits2string, i, 1) = strOne
bmask = bmask * 2 'this would throw an exception the 31'st time.
'multiplication is faster than retreiving values from BITS array.
Next i
If intbit And bmask Then Mid(intbits2string, 2, 1) = strOne
If intbit And BIT31 Then Mid(intbits2string, 1, 1) = strOne
'}
End Function 'intbits2string
Function bits2string(bitvect() As Long) As String
'{
Dim i As Long
For i = UBound(bitvect) To 0 Step -1
bits2string = bits2string & intbits2string(bitvect(i))
Next i
'}
End Function
Function string2bits(bitvect() As Long, bstr As String) As Long()
'{ Converts a string of "1"s and "0"s (actually, any non-1's are treated as
' zeros) into a bit vector and stores it in bitvect. Most significant bits
' appear leftmost within bstr. bitvect must be dynamic (available for ReDim)
' unless bstr will fit within the available length of bitvect.
'
' Returns bitvect().
Dim indx As Long 'within bitvect
Dim ofst As Long 'within each Long in bitvect
Dim posn As Long 'within the input string bstr
Dim lval As Long 'a long valued utility
' Dim digit As String
posn = Len(bstr) - 1
indx = posn \ 32
ofst = (posn And BITS0thru4) + 1
' If bitvect not big enough to hold bit-string,
If indx > UBound(bitvect) Then
ReDim bitvect(0 To indx)
End If
' If bitvect has extra integers in it, make sure they're set to NOBITS.
For lval = UBound(bitvect) To indx + 1 Step -1
bitvect(lval) = NOBITS
Next lval
posn = 1
Do While indx >= 0
lval = NOBITS
Do While ofst > 0
ofst = ofst - 1
'digit = Mid(bstr, posn, 1)
If 0 = StrComp(strOne, Mid(bstr, posn, 1)) Then lval = lval Or Bits(ofst)
posn = posn + 1
Loop
bitvect(indx) = lval
ofst = 32
indx = indx - 1
Loop
' comment out the following two lines if this is working correctly.
' If posn - 1 <> Len(bstr) Then Debug.Print "ERROR 20"
' Debug.Print bits2string(bitvect)
string2bits = bitvect()
'}
End Function 'string2bits
Function promoteSBits(ByVal sval As Integer) As Long
'{
' This function safely converts a 16-Bit-flags value into a 32-bit value.
' Without this, if SBIT15 is set, the value will be interpreted to be negative,
' and all the bits will be scrambled during conversion using a 2's complement
' algorithm.
If sval < 0 Then
'{
'First scrub off BIT15; the negative flag. This is NOT the same as simply
'saying "sval = -sval" which uses 2's complement and scrambles the bits.
sval = sval And (Not SBIT15) 'remove the negative flag.
promoteSBits = sval 'now that it's positive, converts just fine.
promoteSBits = promoteSBits Or BIT15 're-set that problem bit.
'}
Else
'{
promoteSBits = sval 'no problem promoting a positive value.
'}
End If
'}
End Function 'promoteSBits
Function demoteLowBits(ByVal lval As Long) As Integer
'{
' This function safely converts the lowest-order 16 bits of a 32-Bit-flags
' value into a 16-bit value. Without this, if any bits beyond BIT14 are set,
' when the value is demoted to a 16-bit type, an overflow will occur.
' The highest-order 16 bits are just ignored. If you need them, you'll need
' to call demoteHighBits
'First, scrub off ALL 16 higher-order bits.
lval = lval And (BYTE1 Or BYTE0)
'Now deal with that pesky sign bit.
If lval And BIT15 Then 'casting to a 16-bit type will cause overflow.
'{
lval = lval And (Not BIT15) 'clear bit 15. Now it's positive.
demoteLowBits = lval 'positives convert with no problems.
demoteLowBits = demoteLowBits Or SBIT15 're-set bit 15.
'}
Else
'{
demoteLowBits = lval
'}
End If
'}
End Function 'demoteLowBits
Function demoteHighBits(ByVal lval As Long) As Integer
'{
' This function safely converts the highest-order 16 bits of a 32-Bit-flags
' value into a 16-bit value. Without this, if BIT31 is set, during the
' shift to get the high word into the low word, because we HAVE TO USE
' DIVISION in stupid VB (instead of giving us unsigned types and bit shift
' operators: GAUSH! What were they thinking? IDIOT!), the bits will get
' scrambled.
'First deal with that pesky sign bit.
If lval And BIT31 Then 'negative sign will cause bit scrambling.
'{
lval = lval And (Not BIT31) 'clear bit 31. Now it's positive.
demoteHighBits = lval \ 65536 'right-shift 16 positions and demote.
demoteHighBits = demoteHighBits Or SBIT15 'turn bit 31 back on.
'}
Else
'{
demoteHighBits = lval \ 65536
'}
End If
'}
End Function 'demoteHighBits
Function test_bits()
'{ Run the bitvector functions thru some tests.
ReDim testbitvect(0)
ReDim testbitvect2(0)
Dim bitstr As String
Dim bitstr2 As String
Dim cntr As Long
Dim errflag As Boolean
Call initializeBits
Call string2bits(testbitvect, "")
If bitsCompare(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 21": errflag = True
If testbitvect(0) <> NOBITS Then Debug.Print "ERROR 21a": errflag = True
Call string2bits(testbitvect, "1")
' Debug.Print bits2string(testbitvect)
If testbitvect(0) <> BIT0 Then Debug.Print "ERROR 23": errflag = True
Call clearbit(testbitvect, 0)
Call string2bits(testbitvect, "10000000000000000000000000000000")
If testbitvect(0) <> BIT31 Then Debug.Print "ERROR 24": errflag = True
' Debug.Print bits2string(testbitvect)
Call clearbit(testbitvect, 31)
Call string2bits(testbitvect, "100000000000000000000000000000000")
If testbitvect(1) <> BIT0 Then Debug.Print "ERROR 24": errflag = True
' Debug.Print bits2string(testbitvect)
Call clearbit(testbitvect, 32)
If getbit(testbitvect, 5) Then Debug.Print "ERROR 1": errflag = True
If getbit(testbitvect, 50) Then Debug.Print "ERROR 1a": errflag = True
Call setbit(testbitvect, 50)
If togglebit(testbitvect, 50) = 0 Then Debug.Print "ERROR 2": errflag = True
Call togglebit(testbitvect, 31)
' Debug.Print "Bit 31: " & bits2string(testbitvect)
Call clearbit(testbitvect, 31)
If getbit(testbitvect, 31) Then Debug.Print "ERROR 3": errflag = True
Debug.Print "Bit cnt " & "9 | 8 | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0"
Debug.Print "Bit cnt " & "543210987654321098765432109876543210987654321098765432109876543210987654321098765432109876543210"
Call setbit(testbitvect, 64)
Debug.Print "Bit 64: " & bits2string(testbitvect)
Call setbit(testbitvect, 95)
Debug.Print "+Bit 95:" & bits2string(testbitvect)
Call setbit(testbitvect, 0)
Debug.Print "+Bit 0 :" & bits2string(testbitvect)
bitstr = bits2string(testbitvect)
Call string2bits(testbitvect2, bitstr)
Debug.Print "ditto :" & bits2string(testbitvect2)
If bitsCompare(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 22": errflag = True
Call string2bits(testbitvect2, "1")
If testbitvect2(2) <> NOBITS Or testbitvect2(1) <> NOBITS _
Or testbitvect2(0) <> BIT0 Then Debug.Print "ERROR 25": errflag = True
ReDim testbitvect2(0)
If lowestbit(testbitvect) <> 0 Then Debug.Print "ERROR 4": errflag = True
If highestbit(testbitvect) <> 95 Then Debug.Print "ERROR 5": errflag = True
Call clearbit(testbitvect, 95)
Call clearbit(testbitvect, 0)
Call setbit(testbitvect, 31)
Call setbit(testbitvect, 51)
If lowestbit(testbitvect) <> 31 Then Debug.Print "ERROR 6": errflag = True
If highestbit(testbitvect) <> 64 Then Debug.Print "ERROR 7": errflag = True
Call clearbit(testbitvect, 64)
Call clearbit(testbitvect, 31)
Call clearbit(testbitvect, 51)
If lowestbit(testbitvect) <> -1 Then Debug.Print "ERROR 8": errflag = True
No comments have been posted about Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface sli. Why not be the first to post a comment about Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface sli.
