Better TBits.

rtl/objpas/classes/bits.inc

@@ -14,220 +14,230 @@
 {*                               TBits                                      *}
 {****************************************************************************}
 
-Procedure BitsError (const Msg : string);
-begin
-  Raise EBitsError.Create(Msg) at get_caller_addr(get_frame), get_caller_frame(get_frame);
-end;
+const
+   TBITS_SHIFT = BsrDWord(bitsizeof(TBitsBase));
+   TBITS_MASK = 1 shl TBITS_SHIFT - 1;
 
 Procedure BitsErrorFmt (const Msg : string; const Args : array of const);
 begin
   Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame), get_caller_frame(get_frame);
 end;
 
-{Min function for Longint}
-Function liMin(X, Y: Longint): Longint;
-  begin
-    Result := X;
-    if X > Y then Result := Y;
-  end;
-
-procedure TBits.CheckBitIndex (Bit : longint;CurrentSize : Boolean);
+procedure TBits.CheckBitIndex (Bit : SizeInt;CurrentSize : Boolean);
 
 begin
  if (bit<0) or (CurrentSize and (Bit >= FBSize)) then
    BitsErrorFmt(SErrInvalidBitIndex,[bit]);
  if (bit>=MaxBitFlags) then
    BitsErrorFmt(SErrIndexTooLarge,[bit])
-
 end;
 
 { ************* functions to match TBits class ************* }
 
-procedure TBits.setSize(value: longint);
+procedure TBits.setSize(value: SizeInt);
 var
-  newSize, loop: LongInt;
+  newSize: SizeInt;
 begin
   CheckBitIndex(value, false);
-
-  if value <> 0 then
-    newSize :=  (value shr BITSHIFT) + 1
-  else
-    newSize := 0;
-
+  newSize := value shr TBITS_SHIFT + ord(value and TBITS_MASK <> 0);
   if newSize <> FSize then
   begin
-    ReAllocMem(FBits, newSize * SizeOf(longint));
-    if FBits <> nil then
-    begin
-      if newSize > FSize then
-        for loop := FSize to newSize - 1 do
-          FBits^[loop] := 0;
-    end
-    else if newSize > 0 then
-      BitsError(SErrOutOfMemory);  { isn't ReallocMem supposed to throw EOutOfMemory? }
+    ReAllocMem(FBits, newSize * SizeOf(TBitsBase));
+    if newSize > FSize then
+      FillChar(FBits[FSize], (newSize - FSize) * sizeof(TBitsBase), 0);
     FSize := newSize;
   end;
+
+  { If the new size is in the middle of the last chunk, zero its upper bits, so they won't reappear on resizing back. }
+  if value and TBITS_MASK <> 0 then
+    FBits[value shr TBITS_SHIFT] := FBits[value shr TBITS_SHIFT] and TBitsBase(TBitsBaseUnsigned(1) shl (value and TBITS_MASK) - 1);
+
   FBSize := value;
 end;
 
-procedure TBits.SetBit(bit : longint; value : Boolean);
+function TBits.ScanFor1(start : SizeInt; xorMask : TBitsBase) : SizeInt;
 var
-  n: Integer;
+   cell: TBitsBase;
 begin
-  grow(bit+1);   { validates bit range and adjusts FBSize if necessary }
-  n := bit shr BITSHIFT;
-  if value then
-    FBits^[n] := FBits^[n] or (longword(1) shl (bit and MASK))
-  else
-    FBits^[n] := FBits^[n] and not (longword(1) shl (bit and MASK));
+   result := start;
+   while result < FBSize do
+   begin
+      { On first iteration, position ('result') is arbitrary.
+        On subsequent iterations, position is always 0 modulo bitsizeof(TBitsBase) - points to the start of the next FBits item,
+        and (result and TBITS_MASK) becomes 0 (number of lower bits to skip). }
+      cell := (xorMask xor FBits[result shr TBITS_SHIFT]) shr (result and TBITS_MASK);
+      if cell <> 0 then
+      begin
+         result := result + integer(
+{$if sizeof(TBitsBase) = sizeof(word)}
+            BsfWord
+{$elseif sizeof(TBitsBase) = sizeof(dword)}
+            BsfDWord
+{$elseif sizeof(TBitsBase) = sizeof(qword)}
+            BsfQWord
+{$else} {$error unknown TBitsBase} {$endif}
+               (TBitsBaseUnsigned(cell)));
+         if result >= FBSize then
+            result := -1;
+         exit;
+      end;
+      result := (result + bitsizeof(TBitsBase)) and TBitsBase(not TBitsBase(TBITS_MASK));
+   end;
+   result := -1;
 end;
 
-function TBits.OpenBit : longint;
+function TBits.ScanFor1Rev(start : SizeInt; xorMask : TBitsBase) : SizeInt;
 var
-   loop : longint;
-   loop2 : longint;
+   cell: TBitsBase;
 begin
-   result := -1; {should only occur if the whole array is set}
-   { map 0 to -1, 1..32 to 0, etc }
-   for loop := 0 to ((FBSize + MASK) shr BITSHIFT) - 1 do
+   result := start;
+   while result >= 0 do
    begin
-      if FBits^[loop] <> $FFFFFFFF then
-      begin
-         for loop2 := 0 to MASK do
-         begin
-           if (FBits^[loop] and (longint(1) shl loop2)) = 0 then
-           begin
-             result := (loop shl BITSHIFT) + loop2;
-             if result > FBSize then
-               result := FBSize;
-             Exit;
-           end;
-         end;
-      end;
+      { On first iteration, position ('result') is arbitrary.
+        On subsequent iterations, position is always -1 modulo bitsizeof(TBitsBase) - points to the end of the previous FBits item,
+        and ((-result - 1) and TBITS_MASK) becomes 0 (number of upper bits to skip). }
+      cell := TBitsBase((xorMask xor FBits[result shr TBITS_SHIFT]) shl ((-result - 1) and TBITS_MASK));
+      if cell <> 0 then
+         exit(result - TBITS_MASK + integer(
+{$if sizeof(TBitsBase) = sizeof(word)}
+            BsrWord
+{$elseif sizeof(TBitsBase) = sizeof(dword)}
+            BsrDWord
+{$elseif sizeof(TBitsBase) = sizeof(qword)}
+            BsrQWord
+{$else} {$error unknown TBitsBase} {$endif}
+               (TBitsBaseUnsigned(cell))));
+      result := (result - bitsizeof(TBitsBase)) or TBITS_MASK;
    end;
+   result := -1;
+end;
 
-   if FSize < MaxBitRec then
-     result := FBSize;  {first bit of next record}
+procedure TBits.SetBit(bit : SizeInt; value : Boolean);
+var
+   cell: PBitsBase;
+   mask: TBitsBase;
+begin
+   grow(bit+1);
+   cell := FBits + bit shr TBITS_SHIFT;
+   mask := TBitsBase(TBitsBaseUnsigned(1) shl (bit and TBITS_MASK));
+   if value then
+      cell^ := cell^ or mask
+   else
+      cell^ := cell^ and not mask;
+end;
+
+function TBits.OpenBit : SizeInt;
+begin
+   result := ScanFor1(0, -1);
+   if result < 0 then
+      result := FBSize;
 end;
 
 { ******************** TBits ***************************** }
 
 constructor TBits.Create(theSize : longint = 0 );
 begin
-   FSize := 0;
-   FBSize := 0;
-   FBits := nil;
    findIndex := -1;
-   findState := True;  { no reason just setting it to something }
    if TheSize > 0 then grow(theSize);
 end;
 
 destructor TBits.Destroy;
 begin
-   if FBits <> nil then
-      FreeMem(FBits, FSize * SizeOf(longint));
-   FBits := nil;
-
+   FreeMem(FBits);
    inherited Destroy;
 end;
 
-procedure TBits.grow(nbit: longint);
+procedure TBits.grow(nbit: SizeInt);
 begin
   if nbit > FBSize then
     SetSize(nbit);
 end;
 
-function TBits.getFSize : longint;
+function TBits.getFSize : SizeInt;
 begin
    result := FSize;
 end;
 
-procedure TBits.seton(bit : longint);
+procedure TBits.seton(bit : SizeInt);
 begin
-  SetBit(bit, True);
+  grow(bit+1);
+  FBits[bit shr TBITS_SHIFT] := FBits[bit shr TBITS_SHIFT] or TBitsBase(TBitsBaseUnsigned(1) shl (bit and TBITS_MASK))
 end;
 
-procedure TBits.clear(bit : longint);
+procedure TBits.clear(bit : SizeInt);
 begin
-  SetBit(bit, False);
+  grow(bit+1);
+  FBits[bit shr TBITS_SHIFT] := FBits[bit shr TBITS_SHIFT] and not TBitsBase(TBitsBaseUnsigned(1) shl (bit and TBITS_MASK));
 end;
 
 procedure TBits.clearall;
-var
-   loop : longint;
 begin
-   for loop := 0 to FSize - 1 do
-      FBits^[loop] := 0;
+   FillChar(FBits^, FSize * sizeof(TBitsBase), 0);
 { don't clear FBSize here, it will cause exceptions on subsequent reading bit values }
 { use 'Size := 0' to reset everything and deallocate storage }
 end;
 
-function TBits.get(bit : longint) : Boolean;
-var
-   n : longint;
+function TBits.get(bit : SizeInt) : Boolean;
 begin
    CheckBitIndex(bit,true);
-   result := False;
-   n := bit shr BITSHIFT;
-   if (n < FSize) then
-      result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
+   result := FBits[bit shr TBITS_SHIFT] shr (bit and TBITS_MASK) and 1 <> 0;
 end;
 
 procedure TBits.CopyBits(BitSet : TBits);
 begin
   setSize(bitset.Size);
-  Move(bitset.FBits^,FBits^,FSize*SizeOf(cardinal));
+  Move(bitset.FBits^,FBits^,FSize*SizeOf(TBitsBase));
 end;
 
 procedure TBits.andbits(bitset : TBits);
 var
-   n : longint;
-   loop : longint;
+   n, loop : SizeInt;
 begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
+   n := FSize;
+   if bitset.FSize < n then
+      n := bitset.FSize;
 
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] and bitset.FBits^[loop];
+   for loop := 0 to n - 1 do
+      FBits[loop] := FBits[loop] and bitset.FBits[loop];
 
-   for loop := n + 1 to FSize - 1 do
-      FBits^[loop] := 0;
+   if FSize > n then
+      FillChar(FBits[n], (FSize - n) * sizeof(TBitsBase), 0);
 end;
 
 procedure TBits.notbits(bitset : TBits);
 var
-   n : longint;
-   loop : longint;
+   n, loop : SizeInt;
 begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
+   n := FSize;
+   if bitset.FSize < n then
+      n := bitset.FSize;
+
+   for loop := 0 to n - 1 do
+      FBits[loop] := FBits[loop] xor bitset.FBits[loop];
 
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] xor bitset.FBits^[loop];
+   { Zero upper bits, for similar reason as in SetSize. }
+   if FBSize and TBITS_MASK <> 0 then
+      FBits[FBSize shr TBITS_SHIFT] := FBits[FBSize shr TBITS_SHIFT] and TBitsBase(TBitsBaseUnsigned(1) shl (FBSize and TBITS_MASK) - 1);
 end;
 
 procedure TBits.orbits(bitset : TBits);
 var
-   loop : longint;
+   loop : SizeInt;
 begin
    grow(bitset.Size);
 
-   for loop := 0 to bitset.getFSize-1 do
-      FBits^[loop] := FBits^[loop] or bitset.FBits^[loop];
+   for loop := 0 to bitset.FSize - 1 do
+      FBits[loop] := FBits[loop] or bitset.FBits[loop];
 end;
 
 procedure TBits.xorbits(bitset : TBits);
 var
-   loop : longint;
+   loop : SizeInt;
 begin
    grow(bitset.Size);
 
-   for loop := 0 to bitset.getFSize-1 do
-      FBits^[loop] := FBits^[loop] xor bitset.FBits^[loop];
+   for loop := 0 to bitset.FSize - 1 do
+      FBits[loop] := FBits[loop] xor bitset.FBits[loop];
 end;
 
 function TBits.Equals(Obj : TObject): Boolean;
@@ -240,36 +250,32 @@ end;
 
 function TBits.equals(bitset : TBits) : Boolean;
 var
-   n : longint;
-   loop : longint;
+   smallest, largest : TBits;
 begin
-   result := False;
-
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-      if FBits^[loop] <> bitset.FBits^[loop] then exit;
-
-   if FSize - 1 > n then
+   if FBSize < bitset.FBSize then
    begin
-      for loop := n to FSize - 1 do
-         if FBits^[loop] <> 0 then exit;
-   end
-   else if bitset.getFSize - 1 > n then
-      for loop := n to bitset.getFSize - 1 do
-         if bitset.FBits^[loop] <> 0 then exit;
-
-   result := True;  {passed all tests}
+      smallest := self;
+      largest := bitset;
+   end else
+   begin
+      smallest := bitset;
+      largest := self;
+   end;
+
+   result :=
+      (CompareByte(smallest.FBits^, largest.FBits^, smallest.FSize * sizeof(TBitsBase)) = 0) and
+      (
+         { First smallest.FSize TBitsBases were equal, so scan can start from the next. }
+         (largest.FSize = smallest.FSize) or
+         (largest.ScanFor1(smallest.FSize shl TBITS_SHIFT, 0) < 0)
+      );
 end;
 
 
 { us this in place of calling FindFirstBit. It sets the current }
 { index used by FindNextBit and FindPrevBit                     }
 
-procedure TBits.SetIndex(index : longint);
+procedure TBits.SetIndex(index : SizeInt);
 begin
    CheckBitIndex(index,true);
    findIndex := index;
@@ -280,85 +286,30 @@ end;
 { and when it is set to False it looks for bits that are turned      }
 { off (0).                                                           }
 
-function TBits.FindFirstBit(state : boolean) : longint;
-var
-   loop : longint;
-   loop2 : longint;
-   startIndex : longint;
-   stopIndex : Longint;
-   compareVal : cardinal;
+function TBits.FindFirstBit(state : boolean) : SizeInt;
 begin
-   result := -1; {should only occur if none are set}
-
-   findState := state;
-
-   if state = False then
-      compareVal := $FFFFFFFF  { looking for off bits }
-   else
-      compareVal := $00000000; { looking for on bits }
-
-   for loop := 0 to FSize - 1 do
-   begin
-      if FBits^[loop] <> compareVal then
-      begin
-         startIndex := loop * 32;
-         stopIndex:= liMin(StartIndex+31,FBSize -1);
-         for loop2 := startIndex to stopIndex do
-         begin
-            if get(loop2) = state then
-            begin
-               result := loop2;
-               break; { use this as the index to return }
-            end;
-         end;
-         break;  {stop looking for bit in records }
-      end;
-   end;
-
+   { -TBitsBase(not state) is 0 for true or -1 for false, making following ScanFor1s search for 'state'. }
+   result := ScanFor1(0, -TBitsBase(not state));
+   findXorMask := -TBitsBase(not state);
    findIndex := result;
 end;
 
-function TBits.FindNextBit : longint;
-var
-   loop : longint;
+function TBits.FindNextBit : SizeInt;
 begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-
-      for loop := findIndex + 1 to FBSize-1 do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
+   result := findIndex;
+   if result >= 0 then
+   begin
+      result := ScanFor1(result + 1, findXorMask);
       findIndex := result;
    end;
 end;
 
-function TBits.FindPrevBit : longint;
-var
-   loop : longint;
+function TBits.FindPrevBit : SizeInt;
 begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-      for loop := findIndex - 1 downto 0  do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
+   result := findIndex;
+   if result >= 0 then
+   begin
+      result := ScanFor1Rev(result - 1, findXorMask);
       findIndex := result;
    end;
 end;

rtl/objpas/classes/classesh.inc

@@ -372,59 +372,57 @@ Type
 
 {TBits Class}
 
-const
-   BITSHIFT = 5;
-   MASK = 31; {for longs that are 32-bit in size}
-   // to further increase, signed integer limits have to be researched.
-{$ifdef cpu16}
-   MaxBitFlags = $7FE0;
-{$else cpu16}
-   MaxBitFlags = $7FFFFFE0;
-{$endif cpu16}
-   MaxBitRec = MaxBitFlags Div (SizeOf(cardinal)*8);
 type
-   TBitArray = array[0..MaxBitRec - 1] of cardinal;
+   TBitsBase = PtrInt;
+   PBitsBase = ^TBitsBase;
+   TBitsBaseUnsigned = PtrUint;
 
+const
+   MaxBitFlags = High(SizeInt) - (bitsizeof(TBitsBase) - 1);
+
+type
    TBits = class(TObject)
    private
-      { Private declarations }
-      FBits : ^TBitArray;
-      FSize : longint;  { total longints currently allocated }
-      FBSize: longint;  {total bits currently allocated}
-      findIndex : longint;
-      findState : boolean;
+      FBits : PBitsBase;
+      FSize : SizeInt;  { total TBitsBases currently allocated }
+      FBSize: SizeInt;  {total bits currently allocated}
+      findIndex : SizeInt;
+      findXorMask : int8; { 0 (all zeros) or -1 (all ones), sign-extended to TBitsBase on read.
+                            0 is for searching ones, -1 is for searching zeros. }
+
+      function ScanFor1(start : SizeInt; xorMask : TBitsBase) : SizeInt;
+      function ScanFor1Rev(start : SizeInt; xorMask : TBitsBase) : SizeInt;
 
       { functions and properties to match TBits class }
-      procedure SetBit(bit : longint; value : Boolean);
-      procedure SetSize(value : longint);
+      procedure SetBit(bit : SizeInt; value : Boolean);
+      procedure SetSize(value : SizeInt);
    Protected
-      procedure CheckBitIndex (Bit : longint;CurrentSize : Boolean);
+      procedure CheckBitIndex (Bit : SizeInt;CurrentSize : Boolean);
    public
-      { Public declarations }
       constructor Create(TheSize : longint = 0); virtual;
       destructor Destroy; override;
-      function  GetFSize : longint;
-      procedure SetOn(Bit : longint);
-      procedure Clear(Bit : longint);
+      function  GetFSize : SizeInt;
+      procedure SetOn(Bit : SizeInt);
+      procedure Clear(Bit : SizeInt);
       procedure Clearall;
       procedure CopyBits(BitSet : TBits);
       procedure AndBits(BitSet : TBits);
       procedure OrBits(BitSet : TBits);
       procedure XorBits(BitSet : TBits);
       procedure NotBits(BitSet : TBits);
-      function  Get(Bit : longint) : boolean;
-      procedure Grow(NBit : longint);
+      function  Get(Bit : SizeInt) : boolean;
+      procedure Grow(NBit : SizeInt);
       function  Equals(Obj : TObject): Boolean; override; overload;
       function  Equals(BitSet : TBits) : Boolean; overload;
-      procedure SetIndex(Index : longint);
-      function  FindFirstBit(State : boolean) : longint;
-      function  FindNextBit : longint;
-      function  FindPrevBit : longint;
+      procedure SetIndex(Index : SizeInt);
+      function  FindFirstBit(State : boolean) : SizeInt;
+      function  FindNextBit : SizeInt;
+      function  FindPrevBit : SizeInt;
 
       { functions and properties to match TBits class }
-      function OpenBit: longint;
-      property Bits[Bit: longint]: Boolean read get write SetBit; default;
-      property Size: longint read FBSize write setSize;
+      function OpenBit: SizeInt;
+      property Bits[Bit: SizeInt]: Boolean read get write SetBit; default;
+      property Size: SizeInt read FBSize write setSize;
    end;
 
 { TPersistent abstract class }

tests/test/units/classes/ttbits.pp

@@ -1,14 +1,20 @@
 program ttbits;
 
-{$MODE objfpc}{$H+}
+{$MODE objfpc}{$H+} {$coperators on} {$typedaddress on}
 
 uses
-  Classes;
+  Classes, SysUtils, Math;
 
-procedure Fail;
+var
+  somethingFailed: boolean = false;
+
+const
+  Bool01: array[boolean] of char = ('0', '1');
+
+procedure Fail(const msg: string = 'Err!');
 begin
-  Writeln('Err!');
-  Halt(1);
+  Writeln(msg, LineEnding);
+  somethingFailed := true;
 end;
 
 procedure FillWithRandom(b: TBits);
@@ -47,7 +53,291 @@ begin
   end;
 end;
 
+function CreateBits(const src: string): TBits;
+var
+  i: SizeInt;
+begin
+  result := TBits.Create(length(src));
+  for i := 1 to length(src) do
+    result[i - 1] := src[i] = '1';
+end;
+
+function Dump(b: TBits): string;
+var
+  i: SizeInt;
+begin
+  SetLength((@result)^, b.Size);
+  for i := 0 to b.Size - 1 do
+    result[1 + i] := Bool01[b[i]];
+end;
+
+type
+  BinOpEnum = (op_And, op_Or, op_Xor, op_Not);
+
+function ReferenceBinOpResult(const aSrc, bSrc: string; op: BinOpEnum): string;
+var
+  i: SizeInt;
+  va, vb, vr: boolean;
+begin
+  case op of
+    op_Or, op_Xor: SetLength((@result)^, max(length(aSrc), length(bSrc)));
+    op_And, op_Not: SetLength(result, length(aSrc));
+  end;
+
+  for i := 1 to length(result) do
+  begin
+    va := (i <= length(aSrc)) and (aSrc[i] = '1');
+    vb := (i <= length(bSrc)) and (bSrc[i] = '1');
+    case op of
+      op_And: vr := va and vb;
+      op_Or: vr := va or vb;
+      op_Xor, op_Not: vr := va xor vb;
+    end;
+    result[i] := Bool01[vr];
+  end;
+end;
+
+procedure TestBinOp(const aSrc, bSrc: string; op: BinOpEnum; const expect: string);
+var
+  a, b: TBits;
+  msg: string;
+begin
+  a := nil; b := nil;
+  try
+    a := CreateBits(aSrc);
+    b := CreateBits(bSrc);
+
+    case op of
+      op_And: a.AndBits(b);
+      op_Or: a.OrBits(b);
+      op_Xor: a.XorBits(b);
+      op_Not: a.NotBits(b);
+    end;
+
+    if Dump(a) <> expect then
+    begin
+      WriteStr(msg,
+        op, ' failed:', LineEnding,
+        'a        = ', aSrc, LineEnding,
+        'b        = ', bSrc, LineEnding,
+        'expected = ', expect, LineEnding,
+        'got      = ', Dump(a));
+      Fail(msg);
+    end;
+  finally
+    a.Free; b.Free;
+  end;
+end;
+
+procedure TestBinOps;
+const
+  Srcs: array[0 .. 11] of string =
+  (
+    '', '0', '1', '10101',
+    // 1 zero, 1 one, 2 zeros, 2 ones, ..., 11 zeros, 11 ones
+    '010011000111000011110000011111000000111111000000011111110000000011111111000000000111111111000000000011111111110000000000011111111111',
+    // 1 one, 1 zero, 2 ones, 2 zeros, ..., 11 ones, 11 zeros
+    '101100111000111100001111100000111111000000111111100000001111111100000000111111111000000000111111111100000000001111111111100000000000',
+    // 11 zeros, 11 ones, 10 zeros, 10 ones, ..., 1 zero, 1 one
+    '000000000001111111111100000000001111111111000000000111111111000000001111111100000001111111000000111111000001111100001111000111001101',
+    // 11 ones, 11 zeros, 10 ones, 10 zeros, ..., 1 one, 1 zero
+    '111111111110000000000011111111110000000000111111111000000000111111110000000011111110000000111111000000111110000011110000111000110010',
+
+    // 1 zero, 1 one, 2 zeros, 2 ones, ..., 23 zeros, 23 ones
+    '010011000111000011110000011111000000111111000000011111110000000011111111000000000111111111000000000011111111110000000000011111111111' +
+    '000000000000111111111111000000000000011111111111110000000000000011111111111111000000000000000111111111111111000000000000000011111111' +
+    '111111110000000000000000011111111111111111000000000000000000111111111111111111000000000000000000011111111111111111110000000000000000' +
+    '000011111111111111111111000000000000000000000111111111111111111111000000000000000000000011111111111111111111110000000000000000000000' +
+    '011111111111111111111111',
+
+    // 1 one, 1 zero, 2 ones, 2 zeros, ..., 23 ones, 23 zeros
+    '101100111000111100001111100000111111000000111111100000001111111100000000111111111000000000111111111100000000001111111111100000000000' +
+    '111111111111000000000000111111111111100000000000001111111111111100000000000000111111111111111000000000000000111111111111111100000000' +
+    '000000001111111111111111100000000000000000111111111111111111000000000000000000111111111111111111100000000000000000001111111111111111' +
+    '111100000000000000000000111111111111111111111000000000000000000000111111111111111111111100000000000000000000001111111111111111111111' +
+    '100000000000000000000000',
+
+    // 23 zeros, 23 ones, 22 zeros, 22 ones, ..., 1 zero, 1 one
+    '000000000000000000000001111111111111111111111100000000000000000000001111111111111111111111000000000000000000000111111111111111111111' +
+    '000000000000000000001111111111111111111100000000000000000001111111111111111111000000000000000000111111111111111111000000000000000001' +
+    '111111111111111100000000000000001111111111111111000000000000000111111111111111000000000000001111111111111100000000000001111111111111' +
+    '000000000000111111111111000000000001111111111100000000001111111111000000000111111111000000001111111100000001111111000000111111000001' +
+    '111100001111000111001101',
+
+    // 23 ones, 23 zeros, 22 ones, 22 zeros, ..., 1 one, 1 zero
+    '111111111111111111111110000000000000000000000011111111111111111111110000000000000000000000111111111111111111111000000000000000000000' +
+    '111111111111111111110000000000000000000011111111111111111110000000000000000000111111111111111111000000000000000000111111111111111110' +
+    '000000000000000011111111111111110000000000000000111111111111111000000000000000111111111111110000000000000011111111111110000000000000' +
+    '111111111111000000000000111111111110000000000011111111110000000000111111111000000000111111110000000011111110000000111111000000111110' +
+    '000011110000111000110010'
+  );
+var
+  op: BinOpEnum;
+  iA, iB: SizeInt;
+begin
+  TestBinOp('1011', '111001', op_Xor, '010101');
+  for iA := 0 to High(Srcs) do
+    for iB := 0 to High(Srcs) do
+      for op in BinOpEnum do
+        TestBinOp(Srcs[iA], Srcs[iB], op, ReferenceBinOpResult(Srcs[iA], Srcs[iB], op));
+end;
+
+procedure TestFinds(const src: string; state: boolean; const positions: array of int16);
+type
+  DirectionEnum = (LeftToRight, RightToLeft);
+var
+  b: TBits;
+  direction: DirectionEnum;
+  found, iPos, expected: SizeInt;
+  msg: string;
+begin
+  b := nil;
+  try
+    b := CreateBits(src);
+    for direction in DirectionEnum do
+    begin
+      case direction of
+        LeftToRight:
+          begin
+            found := b.FindFirstBit(state);
+            iPos := 0;
+          end;
+        RightToLeft:
+          begin
+            // Emulate non-existing (for now) FindFirstBitRev that searches from the end.
+            b.FindFirstBit(state);
+            if b.Size = 0 then
+              found := -1
+            else
+            begin
+              b.SetIndex(b.Size - 1);
+              if b[b.Size - 1] = state then found := b.Size - 1 else found := b.FindPrevBit;
+            end;
+            iPos := High(positions);
+          end;
+      end;
+
+      repeat
+        if (iPos >= 0) and (iPos < length(positions)) then expected := positions[iPos] else expected := -1;
+        if found <> expected then
+        begin
+          WriteStr(msg, 'Finds failed:' + LineEnding +
+            'src = ' + src + LineEnding +
+            'state = ', Bool01[state], ', dir = ', direction, ', iPos = ', iPos, ', found = ', found, ', expected = ', expected);
+          Fail(msg);
+        end;
+        if expected < 0 then break;
+        case direction of
+          LeftToRight:
+            begin
+              iPos += 1;
+              found := b.FindNextBit;
+            end;
+          RightToLeft:
+            begin
+              iPos -= 1;
+              found := b.FindPrevBit;
+            end;
+        end;
+      until false;
+    end;
+  finally
+    b.Free;
+  end;
+end;
+
+procedure TestFinds;
+var
+  state: boolean;
+  c0, c1: char;
+  positions: array of int16;
+  i, iPos: SizeInt;
+  iRandomTest: int32;
+  r: string;
+begin
+  for state in boolean do
+  begin
+    c0 := Bool01[not state]; c1 := Bool01[state];
+    TestFinds('', state, []);
+    TestFinds(
+      StringOfChar(c0, 30) + c1 + StringOfChar(c0, 39) + c1 + StringOfChar(c0, 49) + c1 + StringOfChar(c0, 59) + c1,
+      state,
+      [30, 70, 120, 180]);
+
+    SetLength((@positions)^, 499);
+    for i := 0 to High(positions) do positions[i] := i + ord(i >= 250);
+    TestFinds(StringOfChar(c1, 250) + c0 + StringOfChar(c1, 249), state, positions);
+
+    TestFinds(c1 + StringOfChar(c0, 254) + c1, state, [0, 255]);
+    TestFinds(c1 + StringOfChar(c0, 255) + c1, state, [0, 256]);
+
+    SetLength(positions, 150);
+    for iRandomTest := 1 to 1000 do
+    begin
+      SetLength((@r)^, random(length(positions)));
+      iPos := 0;
+      for i := 0 to length(r) - 1 do
+        if random(2) = 0 then
+          pChar(pointer(r))[i] := c0
+        else
+        begin
+          pChar(pointer(r))[i] := c1;
+          positions[iPos] := i;
+          iPos += 1;
+        end;
+      TestFinds(r, state, Slice(positions, iPos));
+    end;
+  end;
+end;
+
+procedure TestZeroUpper;
+var
+  b, b2: TBits;
+  expected: string;
+begin
+  b := nil; b2 := nil;
+  try
+    expected := '10111001011';
+    b := CreateBits(expected);
+
+    b.Size := b.Size - 2;
+    SetLength(expected, length(expected) - 2);
+    if Dump(b) <> expected then
+      Fail(
+        'ZeroUpper failed after truncation:' + LineEnding +
+        'expected = ' + expected + LineEnding +
+        'got      = ' + Dump(b));
+
+    b.Size := b.Size + 3;
+    expected += '000';
+    if Dump(b) <> expected then
+      Fail(
+        'ZeroUpper failed after widening:' + LineEnding +
+        'expected = ' + expected + LineEnding +
+        'got      = ' + Dump(b));
+
+    FreeAndNil(b);
+    b := CreateBits('101');
+    b2 := CreateBits('11111');
+    b.NotBits(b2);
+    b.Size := 6;
+    expected := '010000';
+    if Dump(b) <> expected then
+      Fail(
+        'ZeroUpper / NotBits failed:' + LineEnding +
+        'expected = ' + expected + LineEnding +
+        'got      = ' + Dump(b));
+  finally
+    b.Free; b2.Free;
+  end;
+end;
+
 begin
   TestCopyBits;
+  TestBinOps;
+  TestFinds;
+  TestZeroUpper;
+  if somethingFailed then
+    Halt(1);
   Writeln('Ok!');
 end.