• Home
 · 
• Math/Dates
 · 
• Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface sli

Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface sli

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()




Rate Simple bit-vectors. Treats an array of 32-bit integers as a bit vector. Expanded (and interface sli

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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