Handling arbitrary bit length data in Delphi?

I am working on a display/control utility to replace an ancient dedicated hardware controller for a piece of industrial machinary. The controller itself is beyond repair (someone replaced the 1 amp fuse with a 13 amp one "because it kept blowing"). The hardware interface is through a standard RS232 port. The data format is dedicated:

No control characters are used with the exeption of ETB (Chr 23) to demark end of a message.

The data is 7-bit, but only a subset of the possible 7-bit characters is used. The content of each 7-bit data character is therefore effectively reduced to only 6 bits of data.

The data is not character aligned, e.g. for the first message type, the first 3 bits are the message type, the next 8 bits are a counter, the next 15 bits are a data value, next 7 bits are a value etc

So reducing the data from it's 7-bit carrier to it's 6 bit content gives (for example)

|  6 ||  6 ||  6 ||  6 ||  6 ||  6 ||  6 ||~ 
001001010001010100101010101101010101110111 ~
|3||  8   ||     15       ||  7   || ~~   
 M    C          D            D        D
 s    o          a            a        a 
 g    u          t            t        t 
      n          a            a        a
      t 

Specific messages are fixed length but the different messages are of different lengths and contain different numbers of parameters.

I have a working prototype handling one specific message type, but it is currently using way too many case statements ;-).

I am looking for suggestions as to a clean way of handling such packed, arbitrary bit length 开发者_如何转开发data?

I assume that different messages/packets have different variable lengths. A clean way to handle arbitrary bit length data like that would be

uses ubitstream;

procedure decode(buffer: Tbytes; var results: Tcustom_record);
var
  bstream: TBitStream;
  msg: byte;        //  3 bits
  cnt: byte;        //  8 bits
  Data_1: Word;     // 15 bits
  Data_2: Word;     //  7 bits
  Data_3: Word;     // ~~ bits
begin
  bstream:=TBitStream.Create;
  bstream.Load(buffer, sizeof(buffer) );
  msg := bstream.readCardinal(3);
  if msg = 1 then begin
    cnt := bstream.readCardinal(8);
    Data_1 := bstream.readCardinal(15);
    Data_2 := bstream.readCardinal(7);
    Data_3 := bstream.readCardinal(~~);
  end else if msg = 2 then begin // different msg type with different lengths
    cnt := bstream.readCardinal(5);
    Data_1 := bstream.readCardinal(14);
    Data_2 := bstream.readCardinal(12);
    Data_3 := bstream.readCardinal(~~);
  end; // etc etc...
  bstream.free;
end;

You will need ubitstream.pas

unit ubitstream;

interface

uses classes, sysutils;

Type
TBitStream = class
   constructor Create;
   destructor Free;
public
   procedure clear;
   procedure LoadFromStr(s: string);
   procedure Load(fileName: string); overload;
   procedure Load(bs:TBitStream; offset: cardinal; count:cardinal); overload;
   procedure Load(bs:TBitStream; count:cardinal); overload;
   procedure Load(byteArray: TBytes); overload;
   procedure Load(byteArray: TBytes; offset:cardinal); overload;
   procedure Save(fileName: string); overload;
   procedure Save(var byteArray: TBytes); overload;

   function toHex:String;
   function toBin:String;

   //Sequential Access
   function readCardinal(count: integer):cardinal;
   function readBit:byte;
   function readString(count:cardinal):ansistring;

   procedure writeBit(bit: byte);
   procedure writeBits(count: cardinal; data: TBytes); overload;
   procedure writeBits(count: cardinal; pdata: Pbyte); overload;
   procedure writeString(s: ansistring);
   //----------------------------------------------------
   function getSize:smallint;
   procedure setSize(newSize: smallint);
   property Size: smallint read getSize write setSize;
   function getPos: cardinal;
   procedure setPos(newPosition: cardinal);
   property Position: cardinal read getPos write setPos;
   function eos:boolean;//End Of Stream
protected
   //Random Access
   function getCardinal(offset: cardinal; count: cardinal):cardinal;
   function getBit(offset: cardinal):byte;
   function getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;

   procedure setBit(offset: cardinal; bit: byte);
   procedure setBits(offset: cardinal; count: cardinal; data: TBytes);
   //----------------------------------------------------

private
   bits: TBytes;//Array of byte;
   stream_pos: cardinal; //position for sequential operations bits-based
   bitsize: cardinal;
end;

implementation

uses strutils;

constructor TBitStream.Create;
begin
   SetLength(bits,1); //initial size is 1b
   stream_pos := 0;
   bitsize:=8;
end;

destructor TBitStream.Free;
begin
   SetLength(bits,0); //free array
   bits:=nil;
   bitsize:=0;
   stream_pos:=0;
end;

procedure TBitStream.clear;
// clear data
begin
   bits:=nil;
   SetLength(bits,1);
   bits[0] := 0;
   stream_pos := 0;
   bitsize := 8;
end;

function TBitStream.getSize:smallint;
begin
   if (bitsize mod 8)>0 then getSize := (bitsize div 8) +1
   else getSize := bitsize div 8;
end;

procedure TBitStream.setSize(newSize: smallint);
begin
   SetLength(bits,newSize);
   bitsize:=newSize*8;
   if stream_pos>bitsize then stream_pos:=bitsize; //set to end of stream
end;

function TBitStream.getCardinal(offset: cardinal; count: cardinal):cardinal;
//return count of bits from offset as 32-bit data type
//offset and count size in bits   
var 
   res: cardinal;
   i,shift: cardinal;
begin
   getCardinal:=0;
   if (offset+count>Size*8) then raise Exception.Create('Index out of array bounds!');
   if count>32 then exit; //no more than 32-bit
   res := getBit(offset);
//   writeln(offset,' ',getBit(offset),' ',res);
   shift := 1;
   for i:=offset+1 to offset+count-1 do begin
      res := res or (getBit(i) shl shift);
      inc(shift);
//      writeln(i,' ',getBit(i),' ',res);
   end;
   getCardinal := res;
end;

procedure TBitStream.setBit(offset: cardinal; bit: byte);
//offset in bits
var 
   b: byte;
   off1: cardinal;
   pos1: byte;
begin
   if (offset>=Size*8) then 
   begin 
      SetLength(bits,(offset div 8)+1); 
   end;
   bitsize:=offset;
   off1 := offset div 8;
   pos1 := offset mod 8;
   b := bits[off1];
   if bit=0 then begin //drop bit
      b := b and (not (1 shl pos1));
   end else begin //set bit
      b := b or (1 shl pos1);
   end;
   bits[off1] := b;
end;

procedure TBitStream.setBits(offset: cardinal; count: cardinal; data: TBytes);
//set count of bits at offset from bytes array
//offset and count size in bits   
var
   i,j: cardinal;
   b,bit: byte;
   byteCount: cardinal;
   off: cardinal;
Label STOP;   
begin
   if (offset+count>=Size*8) then begin
      SetLength(bits,((offset+count) div 8)+1); //Reallocate bits array
   end;
   bitsize:=offset+count;
   byteCount := count div 8;
   off := offset;
   if (count mod 8)>0 then inc(byteCount);
   for i:=0 to byteCount-1 do begin //dynamic arrays is zero-based
      b  := data[i]; 
      for j:=0 to 7 do begin //all bits in byte
         bit := (b and (1 shl j)) shr j; 
         setBit(off,bit);
         inc(off);
         if (off>offset+count) then goto STOP;
      end;
   end;
STOP:
end;

function TBitStream.getBit(offset: cardinal):byte;
//offset in bits
var 
   b: byte;
   off1: cardinal;
   pos1: byte;
begin
   getBit := 0;
   if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
   off1 := offset div 8;
   pos1 := offset mod 8;
//   if (offset mod 8)>0 then inc(off1);
   b := bits[off1];
   b := (b and (1 shl pos1)) shr pos1;//get bit
   getBit := b;
end;

function TBitStream.getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;
//count, offset in bits
var
   s: ansistring;
   len,i: cardinal;
   b: byte;
   off: cardinal;
begin
   getString:='';
   s := '';
   readCount := 0;
   off := offset;
   if (count mod 7)<>0 then exit; //string must contain 7-bits chars....
   len := count div 7;
   for i:=1 to len do begin 
      if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
      b := getCardinal(off,7); 
      inc(off,7);
      inc(readCount,7);
      if b=$7F then break; //this is EOL code
      s := s + ansichar(b);
   end;
   getString := s;
end;

function TBitStream.toHex:String;
var 
   i:integer;
   s,res:string;
begin
   res:='';
   for i:=Low(bits) to High(bits) do begin
      s := Format('%02.2X ',[bits[i]]);
      res := res + s;
   end;
   toHex := res;
end;

function TBitStream.toBin:String;
var 
   i,j:integer;
   s,res:string;
   b: byte;
begin
   res:='';
   for i:=Low(bits) to High(bits) do begin
      //s := Format('%02.2X',[bits[i]]);
      b := bits[i];
      s:='';
      for j:=7 downto 0 do begin
         if (b and (1 shl j))>0 then s:=s+'1' else s:=s+'0';
      end;
      s := s+' ';
      res := res + s;
   end;
   toBin := res;
end;

procedure TBitStream.LoadFromStr(s: string);
//load data from hex string
var 
   i,j: cardinal;
   b: byte;
   c1,c2:byte;
begin
   clear;
   s:=AnsiReplaceStr(s,' ','');
   if (length(s) mod 2) <> 0 then exit;
   i:=1;j:=0;
   SetLength(bits, length(s) div 2);
   bitsize:=(length(s) div 2 ) * 8; 
   repeat 
      c1:=0; c2:=0;
      if s[i] in ['0','1','2','3','4','5','6','7','8','9'] then c1:=ord(s[i])-$30;
      if s[i] in ['A','B','C','D','E','F'] then c1:=10+ord(s[i])-$41;
      if s[i+1] in ['0','1','2','3','4','5','6','7','8','9'] then c2:=ord(s[i+1])-$30;
      if s[i+1] in ['A','B','C','D','E','F'] then c2:=10+ord(s[i+1])-$41;
      b:=c1*16+c2;
      bits[j]:=b;
      inc(i,2);
      inc(j);
   until i>=length(s);
end;

procedure TBitStream.Load(fileName: string);
//load data from binary file
var 
   f: file of byte;
   i: cardinal;
   b: byte;
begin
   clear;
   i:=0;
   assign(f,fileName);
   reset(f);
   while not eof(f) do begin
      blockread(f,b,1);
      SetLength(bits,i+1);
      bitsize:= (i+1) * 8;
      bits[i] := b;
      inc(i);
   end;
   close(f);
end;

procedure TBitStream.Save(fileName: string);
//save data to binary file
var
   i:cardinal;
   f: file of byte;
   b: byte;
begin
   assign(f,fileName);
   rewrite(f);
   for i:=Low(bits) to High(bits) do begin
      b := bits[i];
      blockwrite(f,b,1);
   end;
   close(f);
end;

procedure TBitStream.Save(var byteArray: TBytes);
//save data to array of bytes
var 
   i: cardinal;
begin
   byteArray:=nil; //dealloc bytearray
   SetLength(byteArray,Size);
   for i:=0 to Size-1 do begin
      byteArray[i] := bits[i];
   end;
end;


procedure TBitStream.Load(bs:TBitStream; offset: cardinal; count: cardinal);
//load data from other stream
//offset/count in bits
var
   i,len,off: cardinal;
   b: byte;
begin
   clear;
   off := offset;
   len := count div 8;
   setLength(bits, len);
   bitsize:=count;
   for i:=0 to len-1 do begin
      b:=bs.getCardinal(off,8);
      if (i>Size) then begin
         SetLength(bits,i+1);
      end;
      bits[i] := b;   
      inc(off,8);
   end;
end;

procedure TBitStream.Load(bs:TBitStream; count: cardinal);
//load data from other stream
//count in bits
begin
   Load(bs, bs.Position, count);
   bs.Position:=bs.Position+count;
end;

procedure TBitStream.Load(byteArray: TBytes);
//load data from array of bytes
var
   i,len: cardinal;
begin
   clear;
   len := High(byteArray)+1;
   setLength(bits, len);
   bitsize:=len * 8;
   for i:=0 to len-1 do begin
      bits[i] := byteArray[i];
   end;
end;

procedure TBitStream.Load(byteArray: TBytes; offset:cardinal);
//offset in bytes
var
   i,len: cardinal;
begin
   clear;
   len := High(byteArray)+1;
   if offset>len then exit;
   setLength(bits, len-offset);
   bitsize:=(len-offset) * 8;
   for i:=offset to len-1 do begin
      bits[i-offset] := byteArray[i];
   end;
end;

function TBitStream.getPos: cardinal;
begin
   getPos := stream_pos;
end;

procedure TBitStream.setPos(newPosition: cardinal);
begin
   if (newPosition>bitsize) then exit;
   stream_pos := newPosition;
end;

function TBitStream.readCardinal(count: integer):cardinal;
begin
   readCardinal := getCardinal(stream_pos, count);
   inc(stream_pos,count);
end;

function TBitStream.readBit:byte;
begin
   readBit := getBit(stream_pos);
   inc(stream_pos);
end;

function TBitStream.readString(count:cardinal):ansistring;
//count in bits
var readCount: cardinal;
begin
   readString := getString(stream_pos,count,readCount);
   inc(stream_pos,readCount);
end;

procedure TBitStream.writeBit(bit: byte);
begin
   setBit(stream_pos,bit);
   inc(stream_pos);
end;

procedure TBitStream.writeBits(count: cardinal; data: TBytes);
begin
   setBits(stream_pos,count,data);
   inc(stream_pos,count);
end;

procedure TBitStream.writeBits(count: cardinal; pdata: pbyte);
var
   i:cardinal;
   len:cardinal;
   bytes: TBytes;
begin
   len:=count div 8;
   if (count mod 8)>0 then inc(len);
   setLength(bytes,len);
   for i:=0 to len-1 do begin
      bytes[i]:=pdata^;
      inc(pdata);
   end;
   writeBits(count,bytes);
end;

function TBitStream.eos:boolean;
begin
   eos := stream_pos=bitsize;//High(bits)+1;
end;

procedure TBitStream.writeString(s: ansistring);
var
   i:cardinal;
   b:Tbytes;
begin
   setLength(b,1);
   for i:=1 to length(s) do begin
      b[0]:=byte(s[i]);
      setBits(stream_pos,7,b);
      inc(stream_pos,7);
   end;
   b[0]:=$7f;
   setBits(stream_pos,7,b);
   inc(stream_pos,7);
   b:=nil;
end;

end.

Use SHL/SHR along with masking to read out of your buffer. I would write a few functions to operate against the buffer (which I would declare as an array of byte) and return the value of a specific number of bits form a starting bit position. For instance, lets say that your largest value will never be more than 16 bits (a word). Since your mapped to an array of bytes, if you always grab 3 bytes from the array (watch for the upper bounds) and throw into an integer you can then mask and shift to get your specific value. The location of the bytes you want to get will then be (assuming a 0 based array):

Byte1Index = FirstBit DIV 8;
Byte2Index = Byte1Index + 1;
Byte3Index = Byte1Index + 2;

Pull these into your integer from your array.

TempInt := 0;
if Byte1Index <= High(Buffer) then
  TempInt := Buffer[Byte1Index];
if Byte2Index <= High(Buffer) then 
  TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 8);
if Byte3Index <= High(Buffer) then
  TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 16);

Then adjust your result to align properly

if FirstBit MOD 8 <> 0 then
  TempInt := TempInt SHR (FirstBit MOD 8);

Then mask against the most number of bits you want to return:

Result := TempInt AND $00003FFF;

You can build the final mask programatically:

FinalMask := ($FFFFFFFF shl bitcount) xor $FFFFFFFF;

EDIT

This method is currently limited to 32 bits, but can be extended to at the most 64 bits by changing the masks from 32bit integers to 64bit integers (from $FFFFFFFF to $FFFFFFFFFFFFFFFF for example). Performance gains can also be made by not loading the extra bytes if they aren't needed, I just included here examples for 16 bits, however you will always want to grab at least an extra byte if the Bitsneeded + FirstBiT MOD 8 <> 0

For the messaging side of things I would create a base object which knows how to read data out of a buffer, then extend this into an object which knows how to also read parameters, and then create object descendants which know how to process each message type. You would still have a case statement, but it would be at a simple dispatcher level doing nothing more than passing the buffer off to the appropriate object to handle.

One possible way to handle this, while being terribly inefficient in terms of memory usage, would be to break up the bits as the data is read in. So, let's say you read in the data from the port in 8-bit (1-byte) chunks. Your first read would bring in 00100101. Break this into an array of 8 integers (e.g. bits[0] := 0; bits[1] := 0; bits[2] := 1; ...)

Now you can write helper routine(s) that will retrieve the value you are looking for from the array:

function getInt(start, len: integer): integer;
function getChar(start: integer): String;

These functions would use the start (and possibly len) parameters to combine the appropriate bits out of your array into a usable value.

I'd probably use ASM blocks to handle this with some assembler code - if you can use x86 assembly it would be much easier to parse the data and convert them to a more readable format to pass along.