Der DEC x32 ASM in x64/PurePascal Konvertierungsthread

[Namenloser]

Ich hab mich mal an CRC16 versucht, konnte es aber nicht testen (und aus einer Stelle bin ich nicht so richtig schlau geworden):

Delphi-Quellcode:

function CRC16(CRC: Word; const Buffer; Size: Cardinal): Word;
{$IFDEF PUREPASCAL}
{$MESSAGE WARN 'UNTESTED CODE: CRC16'}
// EAX = CRC
// EDX = Buffer
// ECX = Size
var
  Lookup: PCRCDef;
  BufferByte: PByte;
  B: Byte;
begin
  if Size=0 then
  begin
    Result := CRC;
    exit;
  end;
  {$IFDEF PIC}
    // I assume this line exists in the original to use the code from a class
    // with a custom lookup table which is not possible with pure pascal
    {$MESSAGE ERROR 'MOV   ESI,[EBX].FCRC16 ??'}
  {$ELSE}
    Lookup := FCRC16;
  {$ENDIF}
  // EDI = Size
  // ESI = Lookup
  if not Assigned(Lookup) then
    Lookup := CRC16Init;
  // CL = B
  BufferByte := PByte(@Buffer);
  repeat
    B := BufferByte^ xor Byte(CRC);
    CRC := (CRC shr 8) xor Lookup.Table[B];

    inc(BufferByte);
    dec(Size);
  until Size=0;
  Result := CRC;
end;

Wär super, wenn du ein paar Unit-Tests bereitstellen könntest.

(Btw: Könntest du mich als Isopod in die Credits schreiben? Ich heiße inzwischen fast überall so (oder ähnlich))

[jbg]

Zitat:

Zitat von NamenLozer (Beitrag 1144920)

Delphi-Quellcode:

  {$IFDEF PIC}
    // I assume this line exists in the original to use the code from a class
    // with a custom lookup table which is not possible with pure pascal
    {$MESSAGE ERROR 'MOV   ESI,[EBX].FCRC16 ??'}
  {$ELSE}

PIC steht für Position Independent Code. Für Kylix hat man das benötigt, da man unter Linux nicht so einfach auf globale Variablen zugreifen kann. Jeder Zugriff auf globale Variablen muss über die GOT (Global Offset Table) gehen. Und diese steht in EBX, weswegen das EBX Register nicht verloren gehen darf, da man sonst nicht mehr auf globale Variablen zugreifen kann.
Ansonsten sieht deine CRC16 genau so aus wie meine :-)


Hier schon mal

Delphi-Quellcode:

function CRCCode(var CRCDef: TCRCDef; const Buffer; Size: Cardinal): Cardinal;
// do the CRC computation
var
  P: PByte;
  Value: Byte;
begin
  Result := CRCDef.CRC;
  P := @Buffer;
  if (Size <> 0) and (P <> nil) then
  begin
    if CRCDef.Inverse then
    begin
      repeat
        Value := P^ xor Byte(Result);
        Result := (Result shr 8) xor CRCDef.Table[Value];
        Inc(P);
        Dec(Size);
      until Size = 0;
    end
    else
    begin
      Value := Byte(CRCDef.Shift); // move to local variable => cpu register
      repeat
        Result := (Result shl 8) xor CRCDef.Table[Byte(Result shr Value) xor P^];
        Inc(P);
        Dec(Size);
      until Size = 0;
    end;
    CRCDef.CRC := Result;
    Result := (Result xor CRCDef.FinalVector) and CRCDef.Mask;
  end;
end;

function CRCDone(var CRCDef: TCRCDef): Cardinal;
// finalize CRCDef after a computation
begin
  Result := CRCDef.CRC;
  CRCDef.CRC := CRCDef.InitVector;
  Result := (Result xor CRCDef.FinalVector) and CRCDef.Mask;
end;

function CRC16(CRC: Word; const Buffer; Size: Cardinal): Word;
var
  LCRC16: PCRCDef;
  P: PByte;
  CRC32: LongWord;
  Value: Byte;
begin
  if Size <> 0 then
  begin
    LCRC16 := FCRC16;
    if LCRC16 = nil then
      LCRC16 := CRC16Init;

    CRC32 := CRC;
    P := @Buffer;
    repeat
      Value := P^ xor Byte(CRC32);
      CRC32 := (CRC32 shr 8) xor LCRC16.Table[Value];
      Inc(P);
      Dec(Size);
    until Size = 0;
    Result := Word(CRC32);
  end
  else
    Result := CRC;
end;

function CRC32(CRC: Cardinal; const Buffer; Size: Cardinal): Cardinal;
var
  LCRC32: PCRCDef;
  P: PByte;
  CRC32: LongWord;
  Value: Byte;
begin
  if Size <> 0 then
  begin
    LCRC32 := FCRC32;
    if LCRC32 = nil then
      LCRC32 := CRC32Init;

    CRC32 := not CRC; // inverse Input CRC
    P := @Buffer;
    repeat
      Value := P^ xor Byte(CRC32);
      CRC32 := (CRC32 shr 8) xor LCRC32.Table[Value];
      Inc(P);
      Dec(Size);
    until Size = 0;
    Result := not CRC32; // inverse Output CRC
  end
  else
    Result := CRC;
end;

Jetzt fehlt nur noch das Geschoss von CRCSetup.

[Assertor]

Hallo,

ich habe zwischenzeitlich schon den ganzen Code der DEC so umgestellt, dass intern nun wirklich nur noch an TBytes statt Strings gearbeitet wird. Nach heutigem Maßstab und Möglichkeiten, ist dies nur die konsequente Fortsetzung von Hagens Gestaltung.

Schade, das Delphi bei Pointer Arithmetic nicht jedes Spiel mitmacht, so muß man manchmal trickreich über PAnsiChar casten...

Wenn das letzte Geschoss (TM) fertig ist, sehe ich eine Zukunft für die DEC :)

Eine bitte an alle Helfer: Werdet doch auf den nächsten Tagen persönlich bei mir vorstellig zwecks eines verdienten Freibiers (oder Getränk der Wahl) :thumb:

Ich arbeite jetzt an den Unittests für die Hashes, nur so kann ich das ganze Verhalten auch wirksam in allen System prüfen.

Gruß
Assertor

[Namenloser]

Uff, ich hab mich mal an dem fetten Monstrum zu schaffen gemacht. Das ist mein vorläufiges Ergebnis:

Delphi-Quellcode:

function CRCSetup(var CRCDef: TCRCDef; Polynomial, Bits, InitVector,
  FinalVector: Cardinal; Inverse: LongBool): Boolean; register;
var
  XORValue, Value: LongWord;
  Index: Byte;
  i: Integer;
  Carry: Boolean;
  function Add(var Value: LongWord; const Add: LongWord): Boolean; inline;
  begin
    Value := Value + Add;
    Result := (Value < Add); // set Carry Flag on overflow
  end;
  procedure AddC(var Value: LongWord; const Add: LongWord; var Carry: Boolean); inline;
  begin
    if Carry then
    begin
      inc(Value);
      Carry := (Value = 0); // we might cause another overflow by adding the carry bit
      Value := Value + Add;
      Carry := Carry or (Value < Add);
    end
    else
    begin
      Value := Value + Add;
      Carry := (Value < Add);
    end;
  end;
  procedure SubB(var Value: LongWord; const Sub: LongWord; var Carry: Boolean); inline;
  var
    OldValue: LongWord;
  begin
    if Carry then
    begin
      dec(Value);
      Carry := (Value = LongWord(-1));
      OldValue := Value;
      Value := Value - Sub;
      Carry := Carry or (Value > OldValue);
    end
    else
    begin
      OldValue := Value;
      Value := Value - Sub;
      Carry := Carry or (Value > OldValue);
    end;
  end;
  function ShiftR(var Value: LongWord; const Count: Byte): Boolean; inline;
  begin
    Result := Boolean(Value and ($1 shl (Count-1)));
    Value := Value shr Count;
  end;
  procedure ROL(var Value: LongWord; const Count: Byte); inline;
  begin
    Value := (Value shl Count) or (Value shr (32-Count));
  end;
  procedure ROR(var Value: LongWord; const Count: Byte); inline;
  begin
    Value := (Value shr Count) or (Value shl (32-Count));
  end;
begin
  if Bits < 8 then
  begin
    Result := False;
    exit;
  end;

  Carry := False;

  CRCDef.Polynomial := Polynomial;
  CRCDef.Bits := Bits;
  CRCDef.CRC := InitVector;
  CRCDef.InitVector := InitVector;
  CRCDef.FinalVector := FinalVector;
  CRCDef.Inverse := Inverse;
  CRCDef.Shift := Bits - 8;
  CRCDef.Mask := $FFFFFFFF shr Byte(-Bits + 32);

  if Inverse then
  begin
    XORValue := 0;
    repeat
      Carry := ShiftR(Polynomial, 1);
      AddC(XORValue, XORValue, Carry);
      dec(Bits);
    until Bits = 0;

    for Index := 255 downto 0 do
    begin
      Value := Index;

      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;
      if ShiftR(Value, 1) then Value := Value xor XORValue;

      CRCDef.Table[Index] := Value;
    end;
  end
  else
  begin
    XORValue := Polynomial and FinalVector;
    ROL(XORValue, Byte(Bits));
    for Index := 255 downto 0 do
    begin
      Value := Index shl 25;

      if Boolean(Index and $80) then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;
      if Add(Value, Value)      then Value := Value xor XORValue;

      ROR(Value, Byte(Bits));
      CRCDef.Table[Index] := Value;
    end;
  end;

  Result := True;
end;

Es ist aber nahezu ausgeschlossen, dass das fehlerfrei läuft, weil ich über eine Stunde lang im „Blindflug“ daran gearbeitet habe. Da werde ich sicher noch debuggen müssen. Deshalb habe ich auch ein paar Labels usw. vorerst dringelassen, damit man die korrespondierende Stelle im Original schneller findet.

Bin dann mal gespannt auf deinen Unit-Test.

Hab’s jetzt getestet, es funktioniert.

[himitsu]

Zitat:

Zitat von Assertor (Beitrag 1144931)

Schade, das Delphi bei Pointer Arithmetic nicht jedes Spiel mitmacht, so muß man manchmal trickreich über PAnsiChar casten...

Hast du auch sowas wie Folgendes versucht?

Delphi-Quellcode:

type
  TByteArray = array[0..0] of Byte;
  PByteArray = ^TByteArray;

procedure TForm11.FormCreate(Sender: TObject);
var
  P, Q: PByteArray;
begin
  P := Pointer(123);
  Inc(P);

  Q := Pointer(100);
  //Q := Q + 20;  // geht nicht -.-
  //Q := PByteArray(Q) + 20;  // och nicht
  Inc(Q, 23);

  if P = Q then
    Beep;
end;

[edit]
OK, ist natürlich blöd, daß + komischer Weise nicht geht. :gruebel: (D2010)

[jbg]

Hier mal eine relativ schnelle PurePascal Implementierung von CRCSetup (bei Inverse=True kann man kaum einen Unterschied feststellen, bei Inverser=False sind das bei 100000 Aufrufen etwas mehr als 80 Millisekunden).

Delphi-Quellcode:

function CRCSetup(var CRCDef: TCRCDef; Polynomial, Bits, InitVector,
  FinalVector: Cardinal; Inverse: LongBool): Boolean;
// initialize CRCDef according to the parameters, calculate the lookup table
var
  Value, XorValue, OldValue: Cardinal;
  Index: Integer;
  B: Boolean;
  One: Byte;
begin
  if Bits >= 8 then
  begin
    CRCDef.Polynomial := Polynomial;
    CRCDef.Bits := Bits;
    CRCDef.CRC := InitVector;
    CRCDef.InitVector := InitVector;
    CRCDef.FinalVector := FinalVector;
    CRCDef.Inverse := Inverse;
    CRCDef.Shift := Bits - 8;
    Bits := -(Bits - 32);
    CRCDef.Mask := -1 shr Byte(Bits);

    if Inverse then
    begin
      Bits := CRCDef.Bits;
      XorValue := 0;
      repeat
        Inc(XorValue, XorValue + Ord(Polynomial and $1));
        Polynomial := Polynomial shr 1;
        Dec(Bits);
      until Bits = 0;

      One := $1;
      for Index := 255 downto 0 do
      begin
        Value := Index;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        B := Boolean(Value and One); Value := Value shr 1;
        if B then Value := Value xor XorValue;

        CRCDef.Table[Index] := Value;
      end;
    end
    else
    begin
      XorValue := Polynomial and CRCDef.Mask;
      XorValue := (XorValue shl Byte(Bits)) or (XorValue shr (32 - Byte(Bits)));
      for Index := 255 downto 0 do
      begin
        B := Boolean(Index and $000000080); Value := Index shl 25;
        if B then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        OldValue := Value; Inc(Value, Value);
        if Value < OldValue then Value := Value xor XorValue;

        Value := (Value shr Byte(Bits)) or (Value shl (32 - Byte(Bits)));
        CRCDef.Table[Index] := Value;
      end;
    end;
    Result := True;
  end
  else
    Result := False;
end;

[Namenloser]

Sieht ja ähnlich aus wie meine. Macht Loop-Unrolling denn überhaupt noch Sinn heutzutage? Ich habe gelesen, dass es bei modernen CPUs eher kontraproduktiv ist, da diese (kurze) Schleifen erkennen und intelligent cachen.

[jbg]

Zitat:

Zitat von NamenLozer (Beitrag 1144947)

Macht Loop-Unrolling denn überhaupt noch Sinn heutzutage?

In diesem Fall würde eine weitere Schleife ein CPU Register (x86) zu viel brauchen und somit müsste laufend auf den langsamen Speicher zugegriffen werden.

[himitsu]

Hat das One einen besonderen Grund?
Das sollte doch im Prinzip eigentlich eine Konstante sein, dann noch Value(Cardinal) und One(Byte) zu verrechnen ist bestimmt auch nicht sonderlich optimal.
One als Cardinal wäre da besser, oder eben direkt als Konstante.

Ach ja, BOOL (LongBool bei 32 Bit) wäre bestimmt auch Optimaler, als Boolean.
Ich kenn leider keinen direkten booleanischen Delphi/Pascal-Typen, welcher sich anpaßt, aber die Windows-Adaption vom BOOL geht ja och.

In die Falle mit dem nicht mitwachsenden Integer sollten wir auch nicht gleich zu Anfang reinfallen, also NativeInt/NativeUInt.

Wie ist das Eigentlich mit der Geschwindigkeit von Sprüngen? (JUMPs)
Bei meinem Code gibt es 1 bis 2 Variablen weniger, aber dafür einen weiteren JUMP, wegen dem ELSE. (wenn nötig, ginge dann vermutlichdie zusätzliche LOOP)

Delphi-Quellcode:

{$IF not Defined(NativeInt)}
  const
    NativeInt = Integer;
    NativeUInt = Cardinal;
{$IFEND}

function CRCSetup(var CRCDef: TCRCDef; Polynomial, Bits, InitVector,
  FinalVector: NativeUInt; Inverse: BOOL): Boolean;
// initialize CRCDef according to the parameters, calculate the lookup table
const
  HighBit = $1 shl (SizeOf(NativeUInt) * 8 - 1);
var
  Index, Value, XorValue, OldValue: NativeUInt;
  B: BOOL;
begin
  if Bits >= 8 then
  begin
    CRCDef.Polynomial  := Polynomial;
    CRCDef.Bits        := Bits;
    CRCDef.CRC         := InitVector;
    CRCDef.InitVector  := InitVector;
    CRCDef.FinalVector := FinalVector;
    CRCDef.Inverse     := Inverse;
    CRCDef.Shift       := Bits - 8;
    CRCDef.Mask        := -1 shr Byte(Bits);
    if Inverse then
    begin
      Bits     := CRCDef.Bits;
      XorValue := 0;
      repeat
        Inc(XorValue, XorValue + Polynomial and $1);
        Polynomial := Polynomial shr 1;
        Dec(Bits);
      until Bits = 0;
      for Index := 255 downto 0 do
      begin
        Value := Index;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        if BOOL(Value and $1) then Value := (Value shr 1) xor XorValue else Value := Value shr 1;
        CRCDef.Table[Index] := Value;
      end;
    end
    else
    begin
      Bits     := -(Bits - 32);
      XorValue := Polynomial and CRCDef.Mask;
      XorValue := (XorValue shl Byte(Bits)) or (XorValue shr (32 - Byte(Bits)));
      for Index := 255 downto 0 do
      begin
        if BOOL(Index and $80) then Value := (Index shl 25) xor XorValue else Value := Index shl 25;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;

        // oder
        // if NativeInt(Value) < 0 then Value := (Value shl 1) xor XorValue else Value := Value shl 1;
        // statt dem
        // if BOOL(Value and HighBit) then Value := (Value shl 1) xor XorValue else Value := Value shl 1;

        Value := (Value shr Byte(Bits)) or (Value shl (32 - Byte(Bits)));
        CRCDef.Table[Index] := Value;
      end;
    end;
    Result := True;
  end
  else
    Result := False;
end;

[jbg]

Ich habe den Code schon "CPU-View" getuned. NativeInt ist falsch. Int32 wäre die bessere Wahl, aber DEC unterstützt ja auch noch ältere Delphi Versionen wo es noch kein Int32 gab. Das "One" habe ich eingeführt, da der Compiler immer ein "mov ecx, $000000001" eingefügt hat. Da ist der OpCode um einiges größer als wenn er "mov ecx,edi" schreibt (mit edi=$00000001). Wie schon geschrieben. Ich habe den Code "Delphi Compiler Output getuned".

Zum BOOL: Ich möchte hier so wenig wie möglich Compiler Magic haben.