Archive
Archive for May 27, 2013
Bit management under Delphi
May 27, 2013
Leave a comment
I absolutely hate bit management under Delphi. So I wrote this class to solve the problem once and for all. Not just fidling with bits inside a fixed datatype (like a byte or a word) but for memory allocations of any size. It should work fine under Lazarus/freepascal as well.
Here you go
unit bitbuffer; interface //########################################################################## // Class: TBitBuffer // Author: Jon Lennart Aasenden // Purpose: // -General purpose class for manupulating large buffers on bit level // -Possible to store bitbuffer to stream // -Class methods for general bit manipulation on memory segements // larger than fixed datatypes // -Possible to search buffer for unset bits // -Keeps track of unset bits (perfect for database record mapping) //########################################################################## uses sysutils, classes; type EBitBuffer = Class(Exception); TBitOffsetArray = packed array of system.NativeUInt; TBitBuffer = Class(TObject) Private FData: PByte; FDataLng: NativeInt; FDataLen: NativeInt; FBitsMax: NativeUInt; FReadyByte: NativeUInt; FAddr: PByte; BitOfs: 0..255; FByte: Byte; Function GetByte(Const Index:NativeInt):Byte; Procedure SetByte(Const Index:NativeInt;Const Value:Byte); Function GetBit(Const Index:NativeUInt):Boolean; Procedure SetBit(Const Index:NativeUInt;Const Value:Boolean); Public Property Data:PByte read FData; Property Size:NativeInt read FDataLen; Property Count:NativeUInt read FBitsMax; Property Bytes[Const Index:NativeInt]:Byte Read GetByte write SetByte; Property Bits[Const Index:NativeUInt]:Boolean Read GetBit write SetBit;default; Procedure Allocate(MaxBits:NativeUInt); Procedure Release; Function Empty:Boolean; Procedure Zero; class function BitsOf(Const aBytes:NativeInt):NativeUInt; class function BytesOf(aBits:NativeUInt):NativeInt; class function BitsSetInByte(Const Value:Byte):NativeInt; class Function BitGet(Const Index:NativeInt;Const Buffer):Boolean; class procedure BitSet(Const Index:NativeInt;var Buffer; Const Value:Boolean); procedure SaveToStream(Const stream:TStream);virtual; Procedure LoadFromStream(Const stream:TStream);virtual; Procedure SetBitRange(First,Last:NativeUInt; Const Bitvalue:Boolean); Procedure SetBits(Const Value:TBitOffsetArray; Const BitValue:Boolean); Function FindIdleBit(var Value:NativeUInt; Const FromStart:Boolean=False):Boolean; Destructor Destroy;Override; End; implementation const ERR_BitBuffer_InvalidBitIndex = 'Invalid bit index, expected 0..%d not %d'; ERR_BitBuffer_InvalidByteIndex = 'Invalid byte index, expected 0..%d not %d'; ERR_BitBuffer_BitBufferEmpty = 'Bitbuffer is empty error'; ERR_ERR_BitBuffer_INVALIDOFFSET = 'Invalid bit offset, expected 0..%d, not %d'; CNT_BitBuffer_ByteTable: array [0..255] of NativeInt = (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8); //########################################################################## // TBitBuffer //########################################################################## Destructor TBitBuffer.Destroy; Begin If not Empty then Release; inherited; end; class function TBitBuffer.BitsOf(Const aBytes:NativeInt):NativeUInt; Begin result:=aBytes shl 3; end; class function TBitBuffer.BytesOf(aBits:NativeUInt):NativeInt; Function QToNearest(Const Value,Factor:NativeInt):NativeInt; var FTemp: Integer; Begin Result:=Value; FTemp:=Value mod Factor; If FTemp>0 then inc(Result,Factor - FTemp); end; Begin aBits:=QToNearest(aBits,8); result:=aBits shr 3; if (result shl 3) < aBits then inc(result); end; class function TBitBuffer.BitsSetInByte(Const Value:Byte):NativeInt; begin result:=CNT_BitBuffer_ByteTable[Value]; end; class Function TBitBuffer.BitGet(Const Index:NativeInt;Const Buffer):Boolean; var FValue: Byte; FAddr: PByte; BitOfs: 0..255; Begin If Index>=0 then Begin BitOfs:=Index mod 8; FAddr:=PTR(NativeInt(@Buffer) + Index shr 3); FValue:=FAddr^; Result:=(FValue and (1 shl (BitOfs mod 8))) <> 0; end else Raise EBitBuffer.CreateFmt (ERR_ERR_BitBuffer_INVALIDOFFSET,[maxint-1,index]); end; class Procedure TBitBuffer.BitSet(Const Index:NativeInt; var Buffer;Const Value:Boolean); var FByte: Byte; FAddr: PByte; BitOfs: 0..255; FCurrent: Boolean; Begin If Index>=0 then Begin FAddr:=PTR(NativeInt(@Buffer) + Index shr 3); FByte:=FAddr^; BitOfs := Index mod 8; FCurrent:=(FByte and (1 shl (BitOfs mod 8))) <> 0; case value of true: begin (* set bit if not already set *) If FCurrent=False then FByte:=(FByte or (1 shl (BitOfs mod 8))); FAddr^:=FByte; end; false: begin (* clear bit if already set *) If FCurrent then FByte:=(FByte and not (1 shl (BitOfs mod 8))); FAddr^:=FByte; end; end; end else Raise EBitBuffer.CreateFmt (ERR_ERR_BitBuffer_INVALIDOFFSET,[maxint-1,index]); end; procedure TBitBuffer.SaveToStream(Const stream:TStream); var mWriter: TWriter; begin mWriter:=TWriter.Create(stream,1024); try mWriter.WriteInteger(FDataLen); mWriter.Write(FData^,FDataLen); finally mwriter.FlushBuffer; mWriter.Free; end; end; Procedure TBitBuffer.LoadFromStream(Const stream:TStream); var mReader: TReader; mlen: NativeInt; Begin Release; mReader:=TReader.Create(stream,1024); try mLen:=mReader.ReadInteger; if mLen>0 then begin Allocate(BitsOf(mLen)); mReader.Read(FData^,mLen); end; finally mReader.Free; end; end; Function TBitBuffer.Empty:Boolean; Begin result:=FData=NIL; end; Function TBitBuffer.GetByte(Const Index:NativeInt):Byte; Begin If FData<>NIL then Begin If (index>=0) and (Index<FDataLen) then result:=PByte(PTR(FDataLng + index))^ else Raise EBitBuffer.CreateFmt (ERR_BitBuffer_InvalidByteIndex,[FDataLen-1,index]); end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Procedure TBitBuffer.SetByte(Const Index:NativeInt;Const Value:Byte); Begin If FData<>NIL then Begin If (index>=0) and (Index<FDataLen) then PByte(PTR(FDataLng + index))^:=Value else Raise EBitBuffer.CreateFmt (ERR_BitBuffer_InvalidByteIndex,[FDataLen-1,index]); end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Procedure TBitBuffer.SetBitRange(First,Last:NativeUInt; Const Bitvalue:Boolean); var x: NativeUInt; FLongs: NativeInt; FSingles: NativeInt; FCount: NativeUInt; Procedure QSwap(Var Primary,Secondary:NativeUInt); var FTemp: NativeUInt; Begin FTemp:=Primary; Primary:=Secondary; Secondary:=FTemp; end; Function QDiff(Const Primary,Secondary:NativeUInt; Const Exclusive:Boolean=False):NativeUInt; Begin If Primary<>Secondary then Begin If Primary>Secondary then result:=Primary-Secondary else result:=Secondary-Primary; If Exclusive then If (Primary<1) or (Secondary<1) then inc(result); If result<0 then result:=abs(result); end else result:=0; end; Begin If FData<>NIL then Begin If First<FBitsMax then Begin If Last<FBitsMax then Begin (* Conditional swap *) If First>Last then QSwap(First,Last); (* get totals, take ZERO into account *) FCount:=QDiff(First,Last,True); (* use refactoring & loop reduction *) FLongs:=NativeInt(FCount shr 3); x:=First; while FLongs>0 do Begin SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); SetBit(x,Bitvalue);inc(x); dec(FLongs); end; (* process singles *) FSingles:=NativeInt(FCount mod 8); while FSingles>0 do Begin SetBit(x,Bitvalue);inc(x); dec(FSingles); end; end else Begin If First=Last then SetBit(First,True) else Raise EBitBuffer.CreateFmt (ERR_BitBuffer_InvalidBitIndex,[FBitsMax,Last]); end; end else Raise EBitBuffer.CreateFmt(ERR_BitBuffer_InvalidBitIndex, [FBitsMax,First]); end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Procedure TBitBuffer.SetBits(Const Value:TBitOffsetArray; Const BitValue:Boolean); var x: NativeInt; FCount: NativeInt; Begin If FData<>NIL then Begin FCount:=length(Value); If FCount>0 then Begin for x:=low(Value) to High(Value) do SetBit(Value[x],BitValue); end; end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Function TBitBuffer.FindIdleBit(var Value:NativeUInt; Const FromStart:Boolean=False):Boolean; var FOffset: NativeUInt; FBit: NativeUInt; FAddr: PByte; x: NativeInt; Begin result:=FData<>NIL; if result then Begin (* Initialize *) FAddr:=FData; FOffset:=0; If FromStart then FReadyByte:=0; If FReadyByte<1 then Begin (* find byte with idle bit *) While FOffset<NativeUInt(FDataLen) do Begin If BitsSetInByte(FAddr^)=8 then Begin inc(FOffset); inc(FAddr); end else break; end; end else inc(FOffset,FReadyByte); (* Last byte exhausted? *) result:=FOffset<NativeUInt(FDataLen); If result then Begin (* convert to bit index *) FBit:=FOffset shl 3; (* scan byte with free bit in it *) for x:=1 to 8 do Begin If not GetBit(FBit) then Begin Value:=FBit; (* more than 1 bit available in byte? remember that *) FAddr:=FData; inc(FAddr,FOffset); If BitsSetInByte(FAddr^)>7 then FReadyByte:=0 else FReadyByte:=FOffset; Break; end; inc(FBit); end; end; end; end; Function TBitBuffer.GetBit(Const Index:NativeUInt):Boolean; begin If FData<>NIL then Begin If index<FBitsMax then Begin FAddr:=PTR(FDataLng + NativeInt(index shr 3)); BitOfs:=Index mod 8; Result:=(FAddr^ and (1 shl (BitOfs mod 8))) <> 0; end else Raise EBitBuffer.CreateFmt (ERR_BitBuffer_InvalidBitIndex,[Count-1,index]); end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Procedure TBitBuffer.SetBit(Const Index:NativeUInt;Const Value:Boolean); begin If FData<>NIL then Begin If index<FBitsMax then Begin FByte:=PByte(FDataLng + NativeInt(index shr 3))^; BitOfs:=Index mod 8; If Value then Begin (* set bit if not already set *) If (FByte and (1 shl (BitOfs mod 8)))=0 then Begin FByte:=(FByte or (1 shl (BitOfs mod 8))); PByte(FDataLng + NativeInt(index shr 3))^:=FByte; (* if this was the "ready" byte, then reset it to zero *) If (Index shr 3=FReadyByte) and (FReadyByte>0) then Begin If BitsSetInByte(FByte)>7 then FReadyByte:=0; end; end; end else Begin (* clear bit if not already clear *) If (FByte and (1 shl (BitOfs mod 8)))<>0 then Begin FByte:=(FByte and not (1 shl (BitOfs mod 8))); PByte(FDataLng + NativeInt(index shr 3))^:=FByte; (* remember this byte pos *) FReadyByte:=Index shr 3; end; end; end else Raise EBitBuffer.CreateFmt (ERR_BitBuffer_InvalidBitIndex,[Count-1,index]); end else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; Procedure TBitBuffer.Allocate(MaxBits:NativeUInt); Begin (* release buffer if not empty *) If FData<>NIL then Release; If Maxbits>0 then Begin (* Allocate new buffer *) try FReadyByte:=0; FDataLen:=BytesOf(maxBits); FData:=AllocMem(FDataLen); FDataLng:=NativeUInt(FData); FBitsMax:=BitsOf(FDataLen); except on e: exception do Begin FData:=NIL; FDataLen:=0; FBitsMax:=0; FDataLng:=0; Raise; end; end; end; end; Procedure TBitBuffer.Release; Begin If FData<>NIL then Begin try FreeMem(FData); finally FReadyByte:=0; FData:=NIL; FDataLen:=0; FBitsMax:=0; FDataLng:=0; end; end; end; Procedure TBitBuffer.Zero; Begin If FData<>NIL then Fillchar(FData^,FDataLen,byte(0)) else Raise EBitBuffer.Create(ERR_BitBuffer_BitBufferEmpty); end; end.