Bit-Schiebereien

[Sir Rufo]

Wie schnell muss dass denn sein?

Ich frage einen 4-Bit Wert aus 2 Bytes

Code:

1111111001111111

genau 1.000.000 ab und das dauert hier so 18ms.

Wenn das schnell genug ist, dann kann ich den Code hier mal reinstellen.

[p80286]

Zitat von Sir Rufo:

Wenn das schnell genug ist, dann kann ich den Code hier mal reinstellen.

Tu das, ich kann z.Zt. so schlecht tippen

Gruß
K-H

[Sir Rufo]

Ok, hier der Code.

Durch das Verschieben sollten keine Wert mit mehr als 25bit abgerufen werden, da es sonst zu komischen Ergebnissen kommen kann

Es erfolgt keine Überprüfung der Index-Werte ... wer das möchte, der kann sich das ja noch einbauen

UPDATE
Ich habe nochmals ca. 2ms weniger (bei 1.000.000 Zugriffen) herausgekitzelt durch eine Änderung in der GetData Methode

Delphi-Quellcode:

program dp_180297;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.Generics.Collections,
  System.Classes,
  System.SysUtils,
  System.Diagnostics,
  BaseData in 'BaseData.pas',
  BaseDataFactory in 'BaseDataFactory.pas';

type
  TData1 = class( TBaseData )
  public
    property Value1 : Integer index $000604 read GetData; // Offset 6 Bit-Width 4
    property Value2 : Integer index $000010 read GetData; // Offset 0 Bit-Width 16
  end;

procedure ValueCheck( AInstance : TData1 );
begin
  Assert( AInstance.Value1 = 9 );
  Assert( AInstance.Value2 = 65151 );
end;

procedure PerformanceCheck( AInstance : TData1 );
const
  C_ROUNDS = 1000000;
var
  LWatch : TStopwatch;
  LValue : Integer;
  LIdx : Integer;
begin
  LWatch := TStopwatch.StartNew;
  for LIdx := 1 to C_ROUNDS do
    begin
      LValue := AInstance.Value1;
    end;
  LWatch.Stop;

  Writeln( C_ROUNDS, ' Rounds in ', LWatch.ElapsedMilliseconds, 'ms' );
end;

procedure FactoryTest;
var
  LStream : TStream;
  LData : TBytes;
  LInstance : TBaseData;
begin
  TBaseDataFactory.RegisterType( $00, TData1 );

  LStream := TMemoryStream.Create;
  try
    LData := TBytes.Create( $00 { Type } , $02 { Size of Data } , $FE, $7F );
    LStream.Write( LData, Length( LData ) );
    LStream.Seek( 0, soFromBeginning );
    LInstance := TBaseDataFactory.CreateFromStream( LStream );
    try
      ValueCheck( LInstance as TData1 );
    finally
      LInstance.Free;
    end;
  finally
    LStream.Free;
  end;
end;

procedure Main;
var
  LData : TBytes;
  LInstance : TData1;
begin

  LData := TBytes.Create( $FE, $7F );
  // 1111111001111111
  // ......====......
  // Value1 ^ = 1001(bin) = 9(decimal)

  LInstance := TData1.Create( LData );
  try
    ValueCheck( LInstance );
    PerformanceCheck( LInstance );
  finally
    LInstance.Free;
  end;
end;

begin
  ReportMemoryLeaksOnShutdown := True;

  try
    Main;
    FactoryTest;
  except
    on E : Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;

  ReadLn;

end.

Delphi-Quellcode:

unit BaseData;

interface

uses
  System.SysUtils;

type
  TBaseData = class
  private
    FData : TBytes;
  protected
    function GetData( const Index : integer ) : integer;
  public
    constructor Create( AData : TBytes );
  end;

implementation

{ TBaseData }

constructor TBaseData.Create( AData : TBytes );
begin
  inherited Create;
  FData := AData;
end;

function TBaseData.GetData( const Index : integer ) : integer;
var
  LBitCount : integer;
  LBitOffset : integer;
  LByteOffset : integer;
  LByteIdx : PByte;
  LMask : Byte;
begin
  LBitCount := index and $FF;
  LBitOffset := ( index shr 8 ) and $FFFF;
  LByteOffset := LBitOffset div 8;
  LBitOffset := LBitOffset - LByteOffset * 8;

  LByteIdx := @FData[LByteOffset];

  LMask := ( 1 shl ( 8 - LBitOffset ) ) - 1;
  Result := ( LByteIdx^ and LMask );
  LBitCount := LBitCount - ( 8 - LBitOffset );

  while LBitCount > 0 do
    begin
      Inc( LByteIdx );
      Result := Result shl 8;
      Result := Result or LByteIdx^;
      LBitCount := LBitCount - 8;
    end;

  if LBitCount < 0
  then
    Result := Result shr ( -LBitCount );

end;

end.

Delphi-Quellcode:

unit BaseDataFactory;

interface

uses
  System.Generics.Collections,
  System.Classes,
  System.SysUtils,
  BaseData;

type
  TBaseDataClass = class of TBaseData;

  TBaseDataFactory = class
  private
    class var _Types : TDictionary<Byte, TBaseDataClass>;
  protected
    class constructor Create;
    class destructor Destroy;
  public
    class function CreateFromStream( AStream : TStream ) : TBaseData;
    class procedure RegisterType( AType : Byte; AClass : TBaseDataClass );
  end;

implementation

{ TBaseDataFactory }

class constructor TBaseDataFactory.Create;
begin
  _Types := TDictionary<Byte, TBaseDataClass>.Create;
end;

class function TBaseDataFactory.CreateFromStream( AStream : TStream ) : TBaseData;
var
  LType : Byte;
  LSize : Byte;
  LData : TBytes;
  LClass : TBaseDataClass;
begin
  AStream.Read( LType, SizeOf( LType ) );
  AStream.Read( LSize, SizeOf( LSize ) );
  SetLength( LData, LSize );
  AStream.Read( LData, LSize );

  LClass := _Types[LType]; // Bei einem unbekannten Typen wird hier eine Exception geworfen
  Result := LClass.Create( LData );
end;

class destructor TBaseDataFactory.Destroy;
begin
  _Types.Free;
end;

class procedure TBaseDataFactory.RegisterType( AType : Byte; AClass : TBaseDataClass );
begin
  _Types.AddOrSetValue( AType, AClass );
end;

end.

[p80286]

!Danke!

K-H

[Sir Rufo]

Zitat von p80286:

!Danke!

K-H

Bitte

Ein kleines Performance-Update habe ich auch noch eingebaut

[Mavarik]

Zitat von Sir Rufo:

Zitat von p80286:

!Danke!

K-H

Bitte

Ein kleines Performance-Update habe ich auch noch eingebaut

Sehr nett... Coole Idee, sehr Variable, aber auf keinen Fall so schnell wie ein Varianten Record...

Aber da wir immer noch nicht die Struktur kennen...

Mavarik

[himitsu]

Zitat von Sir Rufo:

Delphi-Quellcode:

  LClass := _Types[LType]; // Bei einem unbekannten Typen wird hier eine Exception geworfen
  Result := LClass.Create(LData);

Nur, wenn es den Speicherbereich zufällig nicht gibt, oder wenn die Index-Prüfung im Compiler aktiviert wurde.

Aber die Chance ist recht groß, daß es beim Create knallt.

[Sir Rufo]

Zitat von himitsu:

Zitat von Sir Rufo:

Delphi-Quellcode:

  LClass := _Types[LType]; // Bei einem unbekannten Typen wird hier eine Exception geworfen
  Result := LClass.Create(LData);

Nur, wenn es den Speicherbereich zufällig nicht gibt, oder wenn die Index-Prüfung im Compiler aktiviert wurde.

Aber die Chance ist recht groß, daß es beim Create knallt.

Öhm, das ist mir bei einem TDictionary noch nicht aufgefallen.
Kannst du das mal erläutern?

[Sir Rufo]

Sodele, ich habe die Methode nochmals überarbeitet und jetzt kann man auch die vollen 32bit für einen Integer auslesen, ohne dass es einem um die Ohren fliegt

Im Debug-Mode bleibt es bei ca. 16ms und im Release-Mode sind es ca. 7ms (jeweils für 1.000.000 Abfragen). Ich denke mal, das müsste von der Geschwindigkeit ausreichen

Delphi-Quellcode:

unit BaseData;

interface

uses
  System.SysUtils;

type
  TBaseData = class
  private
    FData : TBytes;
  protected
    function GetData( const Index : integer ) : integer;
  public
    constructor Create( AData : TBytes );
  end;

implementation

{ TBaseData }

constructor TBaseData.Create( AData : TBytes );
begin
  inherited Create;
  FData := AData;
end;

function TBaseData.GetData( const Index : integer ) : integer;
var
  LBitCount : integer;
  LBitOffset : integer;
  LByteOffset : integer;
  LByteIdx : PByte;
  LMask : Byte;
begin
  LBitCount := index and $FF;

  if LBitCount > 32
  then
    raise EArgumentOutOfRangeException.CreateFmt( 'Index %x contains invalid BitWidth %x', [index, LBitCount] );

  LBitOffset := ( index shr 8 ) and $FFFFFF;
  LByteOffset := LBitOffset div 8;
  LBitOffset := LBitOffset - LByteOffset * 8;
  LByteIdx := @FData[LByteOffset];

  { TODO : RangeCheck for LByteOffset }

  if LBitCount > 0
  then
    begin
      LMask := ( 1 shl ( 8 - LBitOffset ) ) - 1;
      Result := ( LByteIdx^ and LMask );
      LBitCount := LBitCount - ( 8 - LBitOffset );
    end
  else
    begin
      Result := 0;
      Exit;
    end;

  while LBitCount >= 8 do
    begin
      Inc( LByteIdx );
      Result := Result shl 8;
      Result := Result or LByteIdx^;
      LBitCount := LBitCount - 8;
    end;

  if LBitCount > 0
  then
    begin
      Inc( LByteIdx );
      Result := Result shl LBitCount;
      LMask := ( 1 shl ( 8 - LBitOffset ) ) - 1;

      Result := Result or ( ( LByteIdx^ shr ( 8 - LBitCount ) ) and LMask );
    end;

end;

end.

[Blup]

Ich vermute in der Methode noch Fehler.

Code:

LBitOffset = 11
LBiCount = 18
Byte        0------- 1------- 2------- 3-------
Bits        01234567 89012345 67890123 45678901
Info        00000000 00010000 11111101 11111000
            $00      $08      $BF      $1F
Erg.        10000111 11101111 11000000 00000000
            $E1      $F7      $03      $00

Ergebnis sollte meiner Meinung nach $0003F7E1 sein, tatsächliches Ergebnis $000117E3.
Scheinbar werden am Anfang und Ende die falschen Bits ausgewählt und auch die Reihenfolge der Byte LSB..MSB stimmt nicht.

Delphi-Quellcode:

const
  FData: array[0..3] of Byte = ($00, $08, $BF, $1F);

function TBaseData.GetData( const Index : integer ) : integer;
var
  LBitCount : integer;
  LBitOffset : integer;
  LByteOffset : integer;
  LByteIdx : PByte;
  LMask : integer;
  LShift: integer;
begin
  LBitCount := Index and $FF;

  if LBitCount > 32
  then
    raise EArgumentOutOfRangeException.CreateFmt( 'Index %x contains invalid BitWidth %x', [index, LBitCount] );

  if LBitCount = 0
  then
    begin
      Result := 0;
      Exit;
    end;

  LBitOffset := ( Index shr 8 ) and $FFFFFF;
  LMask      := $FFFFFFFF shr ( 32 - LBitCount );

  LByteOffset := LBitOffset div 8;
  LBitOffset  := LBitOffset mod 8;

  { RangeCheck for LByteOffset }
  if (Length(FData) - LByteOffSet) < ((7 + LBitCount) div 8)
  then
    raise EArgumentOutOfRangeException.CreateFmt( 'Index %x contains invalid BitOffset %x for BitWidth %x', [Index, LBitOffset, LBitCount] );

  LByteIdx := @FData[LByteOffset];

  Result := LByteIdx^ shr LBitOffset;
  LShift := ( 8 - LBitOffset );
  Dec( LBitCount, LShift);
  Inc( LByteIdx );

  while LBitCount > 0 do
    begin
{$R-}
      Result := Result or (Integer(LByteIdx^) shl LShift);
{$R+}
      Inc( LShift, 8);
      Dec( LBitCount, 8);
      Inc( LByteIdx );
    end;

  Result := Result and LMask;
end;