Der DEC x32 ASM in x64/PurePascal Konvertierungsthread

[Assertor]

Hallo,

ich habe in den letzten Tagen einige Stunden mit der DEC verbracht. Nun sitze ich an einem kleinen Problem fest, wo ich Ideen brauche (Alternativtitel: DEC ASM Portierung 1 von vielen).

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord); assembler;
// Value := Value + 8 * Add
// Value is array[0..7] of LongWord
asm
      MOV     ECX,EDX
      LEA     EDX,[EDX * 8]
      SHR     ECX,29 // 12/13/2011 Fixed
      ADD     [EAX].DWord[ 0],EDX
      ADC     [EAX].DWord[ 4],ECX
      ADC     [EAX].DWord[ 8],0
      ADC     [EAX].DWord[12],0
      ADC     [EAX].DWord[16],0
      ADC     [EAX].DWord[20],0
      ADC     [EAX].DWord[24],0
      ADC     [EAX].DWord[28],0
      JC      HashingOverflowError
end;

Das ganze findet bei Hashfunktionen seine Anwendung. Konkret geht es um die Bit-Zählung, die in Hashkalkulationen einfließt.

Ich habe jetzt die Wahl: x64 ASM oder PurePascal.

Anwendungsbeispiel für o.g. Funktion:

Delphi-Quellcode:

  SwapLongBuffer(FCount, FCount, 4);
  PLongWord(@FBuffer[FBufferSize - 16])^ := FCount[3];
  PLongWord(@FBuffer[FBufferSize - 12])^ := FCount[2];
  PLongWord(@FBuffer[FBufferSize -  8])^ := FCount[1];
  PLongWord(@FBuffer[FBufferSize -  4])^ := FCount[0];
  DoTransform(Pointer(FBuffer));

Ich habe da so meine Probleme, Increment8 ohne großen Aufwand in PurePascal umzusetzen (ich komme ja nicht an die Carry Flags).

Ideen für eine in dem Anwendungsbeispiel taugliche Umsetzung eines 256 bit Integers? 4 UInts, da auch 32 Byte? Wie sieht es da mit Problemen im oberen Bereich von 2^63−1 aus? Ich will ja alte Delphi Versionen ebenfalls unterstützen...

Gruß
Assertor

[Namenloser]

Bezüglich Carry-Flag: Mein erster Gedanke war, die Überlaufprüfung des Compilers zu verwenden. Du könntest für die Funktion die Überlaufprüfung aktivieren und die EIntOverflow-Exception abfangen. Sonderlich schnell ist das vermutlich aber nicht, und auch nicht sonderlich schön zu schreiben. Vielleicht fällt mir ja noch was besseres ein...

Dein Anwendungsbeispiel verstehe ich übrigens nicht: Wo kommt da die Funktion Increment8 vor?

[Uwe Raabe]

Zitat:

Zitat von NamenLozer (Beitrag 1144851)

Dein Anwendungsbeispiel verstehe ich übrigens nicht: Wo kommt da die Funktion Increment8 vor?

Die ganze Prozedur heißt so...

Edit: Quatsch! Frage falsch verstanden...

[Assertor]

Zitat:

Zitat von Uwe Raabe (Beitrag 1144852)

Zitat:

Zitat von NamenLozer (Beitrag 1144851)

Dein Anwendungsbeispiel verstehe ich übrigens nicht: Wo kommt da die Funktion Increment8 vor?

Die ganze Prozedur heißt so...

Nein. Entschuldigung, war zu spät und ich steck gerade im Code.

Das Anwendungsbeispiel nutzt das Array of Longword (FCount), welches per Increment8(FCount, Size) vorher manipuliert wird.

@NamenLozer: Per Exception programmiere ich nicht ;)

Kenn sich vielleicht jemand mit den FPC/XE2 kompatiblen x64 ABIs aus?

Gruß
Assertor

[BUG]

Für pures Pascal konnte ich mir vorstellen, dass man den Wert in kleinere Stücken zerlegt (63 oder 56 Bit) und sich damit quasi ein eigenes carry-Bit schafft.

Aber es wäre schon merkwürdig, wenn für x64 keine passende Instruktionen gäbe.

[Namenloser]

Ich hab zwar keine Ahnung, was eine FPC/XE2 kompatible x64 ABI ist, aber ich habe einfach mal selbst eine PurePascal-Variante für 32-Bit geschrieben:

Delphi-Quellcode:

type
  TData = packed array[0..7] of LongWord;

procedure Increment8Pure(var Value; Add: LongWord);
var
  HiBits: LongWord;
  Add8: LongWord;
  Data: TData absolute Value;
  Carry: Boolean;
  procedure AddC(var Value: LongWord; const Add: LongWord; var Carry: Boolean); inline;
  begin
    if Carry then
    begin
      Value := Value + 1;
      Carry := (Value = 0); // we might cause another overflow by adding the carry bit
    end
    else
      Carry := False;

    Value := Value + Add;
    Carry := Carry or (Value < Add); // set Carry Flag on overflow
  end;
begin
  HiBits := Add shr 29; // Save most significant 3 bits in case an overflow occurs
  Add8 := Add * 8;
  Carry := False;

  AddC(Data[0], Add8, Carry);
  AddC(Data[1], HiBits, Carry);
  AddC(Data[2], 0, Carry);
  AddC(Data[3], 0, Carry);
  AddC(Data[4], 0, Carry);
  AddC(Data[5], 0, Carry);
  AddC(Data[6], 0, Carry);
  AddC(Data[7], 0, Carry);

  if Carry then
    HashingOverflowError;
end;

Im Anhang befindet sich zur Sicherheit ein Testprogramm, das einige Werte addiert und dabei die Ergebnisse meiner Funktion mit dem Original vergleicht. Es werden ein paar Werte übersprungen („boost“), weil es natürlich im wahrsten Sinne des Wortes ewig dauern würde, alle 2^XXX Werte durchzuiterieren, aber die relevanten Konstellationen sind denke ich abgedeckt. Natürlich besteht meine Funktion den Test, sonst würde ich sie ja nicht hier posten ;)

Wie gesagt ist die Funktion für 32-Bit-Systeme ausgelegt, da ich 1. nur ein 32-Bit-Windows und 2. nur ein 32-Bit-Delphi besitze. Sollte aber kein Problem sein, sie ggf. auf 64 Bit anzupassen.

[jaenicke]

Zitat:

Zitat von NamenLozer (Beitrag 1144863)

Wie gesagt ist die Funktion für 32-Bit-Systeme ausgelegt, da ich 1. nur ein 32-Bit-Windows und 2. nur ein 32-Bit-Delphi besitze. Sollte aber kein Problem sein, sie ggf. auf 64 Bit anzupassen.

Sie funktioniert mit XE2 für 64-Bit 1:1 genauso. Zum Vergleich habe ich kurz die Assemblervariante auf 64-Bit umgeschrieben:

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord); assembler;
asm
  MOV EBX,EDX
  LEA EDX,[EDX * 8]
  SHR EBX,29 // 12/13/2011 Fixed
  ADD [ECX].DWord[ 0],EDX
  ADC [ECX].DWord[ 4],EBX
  ADC [ECX].DWord[ 8],0
  ADC [ECX].DWord[12],0
  ADC [ECX].DWord[16],0
  ADC [ECX].DWord[20],0
  ADC [ECX].DWord[24],0
  ADC [ECX].DWord[28],0
  JC HashingOverflowError
end;

Der Test läuft 1:1 durch.

Insgesamt sieht das also so aus mit deiner Variante integriert:

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord); {$IFNDEF PUREPASCAL} assembler; {$ENDIF !PUREPASCAL}
// Value := Value + 8 * Add
// Value is array[0..7] of LongWord
{$IFDEF PUREPASCAL}
var
  HiBits: LongWord;
  Add8: LongWord;
  Data: TData absolute Value;
  Carry: Boolean;
  procedure AddC(var Value: LongWord; const Add: LongWord; var Carry: Boolean); inline;
  begin
    if Carry then
    begin
      Value := Value + 1;
      Carry := (Value = 0); // we might cause another overflow by adding the carry bit
    end
    else
      Carry := False;

    Value := Value + Add;
    Carry := Carry or (Value < Add); // set Carry Flag on overflow
  end;
begin
  HiBits := Add shr 29; // Save most significant 3 bits in case an overflow occurs
  Add8 := Add * 8;
  Carry := False;

  AddC(Data[0], Add8, Carry);
  AddC(Data[1], HiBits, Carry);
  AddC(Data[2], 0, Carry);
  AddC(Data[3], 0, Carry);
  AddC(Data[4], 0, Carry);
  AddC(Data[5], 0, Carry);
  AddC(Data[6], 0, Carry);
  AddC(Data[7], 0, Carry);

  if Carry then
    HashingOverflowError;
end;
{$ELSE !PUREPASCAL}
  {$IFDEF CPUX86}
  asm
    MOV ECX,EDX
    LEA EDX,[EDX * 8]
    SHR ECX,29 // 12/13/2011 Fixed
    ADD [EAX].DWord[ 0],EDX
    ADC [EAX].DWord[ 4],ECX
    ADC [EAX].DWord[ 8],0
    ADC [EAX].DWord[12],0
    ADC [EAX].DWord[16],0
    ADC [EAX].DWord[20],0
    ADC [EAX].DWord[24],0
    ADC [EAX].DWord[28],0
    JC HashingOverflowError
  end;
  {$ENDIF CPUX86}
  {$IFDEF CPUX64}
  asm
    MOV EBX,EDX
    LEA EDX,[EDX * 8]
    SHR EBX,29 // 12/13/2011 Fixed
    ADD [ECX].DWord[ 0],EDX
    ADC [ECX].DWord[ 4],EBX
    ADC [ECX].DWord[ 8],0
    ADC [ECX].DWord[12],0
    ADC [ECX].DWord[16],0
    ADC [ECX].DWord[20],0
    ADC [ECX].DWord[24],0
    ADC [ECX].DWord[28],0
    JC HashingOverflowError
  end;
  {$ENDIF CPUX64}
{$ENDIF !PUREPASCAL}

[himitsu]

Eventuell so?

Die höherbittigen Additionen müssen ja nicht mehr ausgeführt werden, wenn sie nicht nötig sind.
Bin noch etwas müde, aber ich glaube, man kann die beiden IFs auch noch kombinieren, falls nötig.
(also nicht nur über ein billiges OR diese 1-zu-1 zusammenzuhängen)

Delphi-Quellcode:

{$IFDEF PUREPASCAL}
  function AddV(var Value: LongWord; const Add: LongWord): Boolean; inline;
  var
    Temp: LongWord;
  begin
    Temp := Value;
    Value := Value + Add;
    Result := Value < Temp;
  end;
  function AddC(var Value: LongWord): Boolean; inline;
  begin
    Inc(Value);
    Result := Value = 0;
  end;
var
  Data: TData absolute Value;
begin
  if AddV(Data[0], Add shl 3) and AddC(Data[1]) and AddC(Data[2]) and AddC(Data[3])
      and AddC(Data[4]) and AddC(Data[5]) and AddC(Data[6]) and AddC(Data[7]) then
    HashingOverflowError;
  if AddV(Data[1], Add shr 29) and AddC(Data[2]) and AddC(Data[3])
      and AddC(Data[4]) and AddC(Data[5]) and AddC(Data[6]) and AddC(Data[7]) then
    HashingOverflowError;
end;
{$ELSE !PUREPASCAL}

Natürlich ohne vollständige Auswertung der booleanische Ausdrücke und ohne Überlaufprüfung. :angle2:


[add]

Delphi-Quellcode:

  if ((AddV(Data[0], Add shl 3) and AddC(Data[1])) or AddV(Data[1], Add shr 29)) and AddC(Data[2])
      and AddC(Data[3]) and AddC(Data[4]) and AddC(Data[5]) and AddC(Data[6]) and AddC(Data[7]) then
    HashingOverflowError;

Hoffentlich isses richtig.

Aber für 64 Bit würde ich das auch noch auf 64 Bit umstellen und es so weiter zu verkürzen.

Delphi-Quellcode:

{$IFDEF PUREPASCAL}
  function AddV(var Value: UInt64; const Add: UInt64): Boolean; inline;
  var
    Temp: UInt64;
  begin
    Temp := Value;
    Value := Value + Add;
    Result := Value < Temp;
  end;
  function AddC(var Value: UInt64): Boolean; inline;
  begin
    Inc(Value);
    Result := Value = 0;
  end;
var
  Data: TData64 absolute Value;  // array[0..3] of UInt64;
begin
  if AddV(Data[0], UInt64(Add) shl 3) and AddC(Data[1]) and AddC(Data[2]) and AddC(Data[3]) then
    HashingOverflowError;
end;

//////////////////////////////////////

{$IFDEF PUREPASCAL}
  function AddC(var Value: UInt64): Boolean; inline;
  begin
    Inc(Value);
    Result := Value = 0;
  end;
var
  Data: TData64 absolute Value; // array[0..3] of UInt64;
  Temp: UInt64;
begin
  Temp := Value;
  Inc(Data[0], UInt64(Add) shl 3);
  if (Value < Temp) and AddC(Data[1]) and AddC(Data[2]) and AddC(Data[3]) then
    HashingOverflowError;
end;

[Assertor]

Hallo,

Wahnsinn! Ihr habt mich gerade wieder daran erinnert, warum ich mich in der DP angemeldet habe :thumb:

Mit FPC kompatibles x64 ABI (Application Binary Interface) meinte ich Instruktionen, die auch der FPC compiler schluckt, u.U. wegen geänderter Calling Convention. Ob das hier relevant ist, ist eine andere Frage. Leider haben sowohl Delphi als auch FPC so ihre Probleme mit x64 Inline Assembler...

Ich werde das ganze Testen und gebe Feedback, ich sitze noch an den Unittests für die LowLevel (SwapBits etc) und Formatklassen, dann geht es weiter :)

Zwischenstand zur DEC ist: Was bisher wieder läuft, läuft überall (x32/x64 Delphi, x32 C++ Builder soweit ich es testen kann, FPC x64). Es fehlen noch ein ASM Block im Cipher, sowie die CRCs und Randomfunktionen. Letzteres wird Tricky, weil Hagen mit QueryPerformanceCounter arbeitet - unter FPC oder OSX geht das nicht so gut :mrgreen:

Ich stelle hier schonmal die nächste ASM Funktion zur Diskussion und Hijacke damit meinen eigenen Thread:

Delphi-Quellcode:

{ TODO : Consider implementing IDEAMul() as PurePascal if porting to FPC }
function IDEAMul(X, Y: LongWord): LongWord; assembler;
asm
       AND    EAX,0FFFFh
       JZ     @@1
       AND    EDX,0FFFFh
       JZ     @@1
       MUL    EDX
       MOV    EDX,EAX
       MOV    ECX,EAX
       SHR    EDX,16
       SUB    EAX,EDX
       SUB    CX,AX
       ADC    EAX,0
       RET
@@1:   LEA    EAX,[EAX + EDX - 1]
       NEG    EAX
end;

Ich habe übrigens auch bisher alle Änderungen, Wünsche und validen Bugmeldungen, die im Laufe der letzten 2 Jahre in der DP zur DEC eingegangen sind, verarbeitet. Der Text im ChangeLog hat schon gut 22 Lines von großen Änderungen.

Jetzt erstmal Kaffee...

Gruß
Assertor

[jbg]

Zitat:

Zitat von jaenicke (Beitrag 1144868)

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord); assembler;
asm
  MOV EBX,EDX
  LEA EDX,[EDX * 8]
  SHR EBX,29 // 12/13/2011 Fixed
  ADD [ECX].DWord[ 0],EDX
  ADC [ECX].DWord[ 4],EBX
  ADC [ECX].DWord[ 8],0
  ADC [ECX].DWord[12],0
  ADC [ECX].DWord[16],0
  ADC [ECX].DWord[20],0
  ADC [ECX].DWord[24],0
  ADC [ECX].DWord[28],0
  JC HashingOverflowError
end;

1. Das "assembler" ist in Delphi nicht mehr notwendig und wird nur zur Abwärtskompatibilität zu Turbo Pascal unterstützt.
2. Ein [ECX] reicht nicht aus, da dadurch nur auf Speicher in den ersten 4 GB zugegriffen werden kann. Der Addressraum unter x64 aber um einiges größer ist. Also muss [RCX] benutzt werden.
3. Du zerstörst das non-volatile RBX Register. Da hat man nun so viele "Freiwild" Register und du nimmst gerade eines, dass beim Rücksprung wieder seinen originalen Inhalt haben muss.
   Also am besten RBX durch EAX, R9D, R10D oder R11D ersetzen.
4. Ob das "JC HashingOverflowError" so gut mit der strikten Aufrufkonvention unter x64 vereinbar ist, kann ich jetzt nicht beurteilen, da ich den Code des Sprungziels nicht kenne.

Und wenn man schon 64bit Assembler hat kann man den auch gleich verwenden:

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord);
asm
  SHL RDX, 3 // the caller writes to EDX what automatically clears the high DWORD of RDX
  ADD QWORD PTR [RCX     ], RDX
  ADC QWORD PTR [RCX +  8], 0
  ADC QWORD PTR [RCX + 16], 0
  ADC QWORD PTR [RCX + 24], 0
  JC HashingOverflowError
end;

[himitsu]

Zitat:

Zitat von jbg (Beitrag 1144884)

the caller writes to EDX what automatically clears the high DWORD of RDX

Und das ist auch immer definitiv so?
Nja, ein kleiner zusätzlicher Befehl, um das zu leeren/sicherzustellen, sollte auch nicht so sehr stören.



Für eine zukünftig unbestimmte Portierungen auf weitere Systeme/CPUs wäre jeweils eine (zusätzliche) PurePascal-Variante bestimmt kein Nachteil.

[jbg]

Zitat:

Zitat von himitsu (Beitrag 1144885)

Zitat:

Zitat von jbg (Beitrag 1144884)

the caller writes to EDX what automatically clears the high DWORD of RDX

Und das ist auch immer definitiv so?

Ja, da der Prozessor bei einem "MOV EDX, xyz" immer das obere QWORD ablöscht (steht auch so in der x64 Instruction Set Beschreibung) und zudem die Win64 Calling Convention es vorschreibt den zweiten Parameter im RDX Register zu übergeben. Da steht nichts von EDX sondern RDX, also alle Bits.

Zitat:

Für eine zukünftig unbestimmte Portierungen auf weitere Systeme/CPUs wäre jeweils eine (zusätzliche) PurePascal-Variante bestimmt kein Nachteil.

Portabel ist der x64-Assembler Code natürlich nicht. Der ist speziell für Win64 geschrieben. Nur mit PurePascal bist du platformunabhängig.

[jbg]

Zitat:

Zitat von Assertor (Beitrag 1144882)

Ich stelle hier schonmal die nächste ASM Funktion zur Diskussion und Hijacke damit meinen eigenen Thread:

Delphi-Quellcode:

{ TODO : Consider implementing IDEAMul() as PurePascal if porting to FPC }
function IDEAMul(X, Y: LongWord): LongWord; assembler;
asm
       AND    EAX,0FFFFh
       JZ     @@1
       AND    EDX,0FFFFh
       JZ     @@1
       MUL    EDX
       MOV    EDX,EAX
       MOV    ECX,EAX
       SHR    EDX,16
       SUB    EAX,EDX
       SUB    CX,AX
       ADC    EAX,0
       RET
@@1:   LEA    EAX,[EAX + EDX - 1]
       NEG    EAX
end;

Hier die Win64 kompatible Version. Ein "MOV EAX,ECX" das den ersten Parameter in EAX kopiert, reicht aus und alles läuft wie gewohnt weiter.

Delphi-Quellcode:

function IDEAMul(X, Y: LongWord): LongWord; assembler;
asm
{$IFDEF CPUX64}
       MOV EAX,ECX
{$ENDIF CPUX64}
       AND EAX,0FFFFh
       JZ @@1
       AND EDX,0FFFFh
       JZ @@1
       MUL EDX
       MOV EDX,EAX
       MOV ECX,EAX
       SHR EDX,16
       SUB EAX,EDX
       SUB CX,AX
       ADC EAX,0
       RET
@@1: LEA EAX,[EAX + EDX - 1]
       NEG EAX
end;

UPDATE:
Und hier die PurePascal Version:

Delphi-Quellcode:

function IDEAMul(X, Y: LongWord): LongWord;
begin
  X := X and $FFFF;
  if X <> 0 then
  begin
    Y := Y and $FFFF;
    if Y <> 0 then
    begin
      X := X * Y;
      Result := X - (X shr 16);
      if Word(X) < Word(Result) then // carry flag check for "sub cx,ax"
        Inc(Result);
      Exit;
    end;
  end;
  Result := -(X + Y - 1);
end;

[Assertor]

Nice, Andreas :)

Zitat:

Zitat von jbg (Beitrag 1144884)

Ob das "JC HashingOverflowError" so gut mit der strikten Aufrufkonvention unter x64 vereinbar ist, kann ich jetzt nicht beurteilen, da ich den Code des Sprungziels nicht kenne.

Delphi-Quellcode:

procedure HashingOverflowError;
begin
  raise EDECHashException.CreateRes(@sHashingOverflowError);
end;

Sollte imo also kein Problem sein.

Zitat:

Zitat von jbg (Beitrag 1144884)

Und wenn man schon 64bit Assembler hat kann man den auch gleich verwenden:

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord);
asm
  SHL RDX, 3 // the caller writes to EDX what automatically clears the high DWORD of RDX
  ADD QWORD PTR [RCX     ], RDX
  ADC QWORD PTR [RCX +  8], 0
  ADC QWORD PTR [RCX + 16], 0
  ADC QWORD PTR [RCX + 24], 0
  JC HashingOverflowError
end;

Das läuft in x64 Delphi, das RDX Register scheint dem FPC x64 Compiler aber nicht zu gefallen:

Zitat:

Error: Unknown identifier "RDX"

Gleich in der ersten Zeile bei SHL RDX, 3.

Nun gut, ich kenne FPC nicht weiter, möglicherweise ist dies bekannt und über Defines steuerbar. Ggf bleibt dort der Weg über PurePascal, was wegen der breiteren Unterstützung ja mit o.g. Delphi Code möglich ist.

Übrig sind noch gut 9 Assembler Funktionen, bis zur Lauffähigkeit. Wenn keine Einwände bestehen, würde ich diese gerne ebenfalls in diesem Thread zur Diskussion stellen.

@Andreas: Gerade schon ein Ping für Dein IDEAMul Post bekommen. Wow, Du bist schnell :)

Gruß
Assertor

P.S: Das wird eine lange Namensliste im ChangeLog - Attribution to Himitsu, Jaenicke, jbg, NamenLozer (alphabetisch) :)

[Assertor]

So, weiter geht es (*):

Delphi-Quellcode:

function DoRndBuffer(Seed: Cardinal; var Buffer; Size: Integer): Cardinal; assembler;
// comparable to Borlands Random() function
asm
      AND     EDX,EDX
      JZ      @@2
      AND     ECX,ECX
      JLE     @@2
      PUSH    EBX
@@1:  IMUL    EAX,EAX,08088405H // 134775813
      INC     EAX
      MOV     EBX,EAX
      SHR     EBX,24
      MOV     [EDX],BL
      INC     EDX
      DEC     ECX
      JNZ     @@1
      POP     EBX
@@2:
end;

function RandomSystemTime: Cardinal; assembler;
// create Seed from Systemtime and PerformanceCounter
var
  SysTime: record
    Year: Word;
    Month: Word;
    DayOfWeek: Word;
    Day: Word;
    Hour: Word;
    Minute: Word;
    Second: Word;
    MilliSeconds: Word;
    Reserved: array [0..7] of Byte;
  end;
  Counter: record
    Lo,
    Hi: Integer;
  end;
asm
      LEA     EAX,SysTime
      PUSH    EAX
      CALL    GetSystemTime
      MOVZX   EAX,Word Ptr SysTime.Hour
      IMUL    EAX,60
      ADD     AX,SysTime.Minute
      IMUL    EAX,60
      MOVZX   ECX,Word Ptr SysTime.Second
      ADD     EAX,ECX
      IMUL    EAX,1000
      MOV     CX,SysTime.MilliSeconds
      ADD     EAX,ECX
      PUSH    EAX
      LEA     EAX,Counter
      PUSH    EAX
      CALL    QueryPerformanceCounter
      POP     EAX
      ADD     EAX,Counter.Hi
      ADC     EAX,Counter.Lo
end;

Bei RandomSystemTime wird es tricky: QueryPerformanceCounter in RandomSystemTime ist natürlich ein No-Go für Crossplatform, also bleibt nur PurePascal.

Kennt da jemand was, was auch FPC versteht? Wie gesagt, ich arbeite nicht mit FPC, das hier ist nur für die Vielen, die danach fragen... Ich muß erstmal die RTL von XE2 durchsuchen, ob es eine Win/OSX Kapselung gibt.

Falls sich jemand fragt, wie viel noch kommt: die CRC Funktionen (5 an der Zahl).

@Himitsu: Hattest Du nicht schonmal LHSZ für FPC bzw. x64 portiert? Ich meine mich da an irgendwas zu erinnern...

Ihr seid klasse :) Während hier Code gepostet wird, kann ich schon an anderer Stelle weitermachen - so könnte die DEC 6.0 wirklich was werden!

Gruß
Assertor

(*) Kein Edit, für die Benachrichtigung - Andreas hat ja gerade einen Lauf :)

[jbg]

Also für beide Funktionen ist überhaupt kein Assembler notwendig. Vor allem nicht für DoRndBuffer. Delphi generiert da fast haargenau den selben Assemblercode.
Was aber bei allen PurePascal Funktionen wichtig ist, ist dass {$RANGECHECKS OFF} genutzt wird, da sonst die gewünschten Arithmetiküberläufe zu Exceptions führen.

Delphi-Quellcode:

function RandomSystemTime: Cardinal;
// create Seed from Systemtime and PerformanceCounter
type
  TInt64Rec = packed record
    Lo, Hi: LongWord;
  end;
var
  {$IFDEF MSWINDOWS}
  SysTime: TSystemTime;
  {$ELSE}
  Hour, Minute, Second, Milliseconds: Word;
  {$ENDIF MSWINDOWS}
  Counter: TInt64Rec;
  Time: Cardinal;
begin
  {$IFDEF MSWINDOWS}
  GetSystemTime(SysTime);
  Time := ((Cardinal(SysTime.wHour) * 60 + SysTime.wMinute) * 60 + SysTime.wSecond) * 1000 + SysTime.wMilliseconds;
  QueryPerformanceCounter(Int64(Counter));
  {$ELSE}
  DecodeTime(Now, Hour, Minute, Second, Milliseconds);
  Time := ((Cardinal(Hour) * 60 + Minute) * 60 + Second) * 1000 + Milliseconds;
  Int64(Counter) := TStopwatch.GetTimeStamp; // uses System.Diagnostics
  {$ENDIF MSWINDOWS}

  Result := Time + Counter.Hi;
  Inc(Result, Ord(Result < Time)); // add "carry flag"
  Inc(Result, Counter.Lo);
end;

function DoRndBuffer(Seed: Cardinal; var Buffer; Size: Integer): Cardinal;
// comparable to Borlands Random() function
var
  P: PByte;
begin
  Result := Seed;
  P := @Buffer;
  if P <> nil then
  begin
    while Size > 0 do
    begin
      Result := Result * $08088405 + 1;
      P^ := Byte(Result shr 24);
      Inc(P);
      Dec(Size);
    end;
  end;
end;

[himitsu]

Zitat:

Zitat von Assertor (Beitrag 1144895)

@Himitsu: Hattest Du nicht schonmal LHSZ für FPC bzw. x64 portiert? Ich meine mich da an irgendwas zu erinnern...

Gute Frage :gruebel:

Selber arbeite ich nicht mit FPC (das Mistding Compilerchen mochte mich nicht ... vonwegen installieren und fertig).

Ich könnte höchsten mal sehn, ob ich noch was (wieder)finde.


Ach ja, mit kleinem h :zwinker:
Ich kenn zwar noch eine Himitsu, aber die hat es nicht so, mit dem Programmieren. :stupid:

[Assertor]

Danke, Andreas!

Damit komme ich viel weiter, TStopWatch muß ich nur unter FPC ersetzen - aber da findet sich was.

Ich hänge die letzte Datei einfach mal an, dort sind 5 Funktionen zur CRC16/CRC32 Berechnung. Hagen hatte den Code seinerzeit sicherlich auf Performance optimiert.

In PurePascal wird das schon etwas schwieriger...

Zitat:

Zitat von himitsu (Beitrag 1144901)

Zitat:

Zitat von Assertor (Beitrag 1144895)

@Himitsu: Hattest Du nicht schonmal LHSZ für FPC bzw. x64 portiert? Ich meine mich da an irgendwas zu erinnern...

Gute Frage :gruebel:

Selber arbeite ich nicht mit FPC (das Mistding Compilerchen mochte mich nicht ... vonwegen installieren und fertig).

Ich könnte höchsten mal sehn, ob ich noch was (wieder)finde.

Ach ja, mit kleinem h :zwinker:
Ich kenn zwar noch eine Himitsu, aber die hat es nicht so, mit dem Programmieren. :stupid:

Ok, himitsu - ist notiert :oops:

Falls Du die Anpassungen noch hast, gerne her damit. Es steht inzwischen fest, dass ich lediglich die CPU.pas, ASN1.pas und TypInfoEx.pas *nicht* mehr weiterpflege. Diese fliegen raus aus der DEC und werden in ein Tools Archiv verschoben - für den Crypto Einsatz sind diese auch nicht notwendig. Ja, ich weiß. ASN1... Trotzem, nicht für den üblichen DEC Anwender.

Tricky wird dann noch, überall die Kompatibilität herzustellen und zu prüfen (DEC 5.1 <> DEC 6.0), also bitte nicht in den nächsten Wochen mit einem Release rechnen. Ich poste dann, wenn ich Beta Tester suche (x32/x64, C++ Builder, Delphi, FPC, Win, Mac und Linux... puh!).

Viele Grüße
Assertor

[Namenloser]

Zitat:

Zitat von jaenicke (Beitrag 1144868)

Zum Vergleich habe ich kurz die Assemblervariante auf 64-Bit umgeschrieben:

Delphi-Quellcode:

procedure Increment8(var Value; Add: LongWord); assembler;
asm
  MOV EBX,EDX
  LEA EDX,[EDX * 8]
  SHR EBX,29 // 12/13/2011 Fixed
  ADD [ECX].DWord[ 0],EDX
  ADC [ECX].DWord[ 4],EBX
  ADC [ECX].DWord[ 8],0
  ADC [ECX].DWord[12],0
  ADC [ECX].DWord[16],0
  ADC [ECX].DWord[20],0
  ADC [ECX].DWord[24],0
  ADC [ECX].DWord[28],0
  JC HashingOverflowError
end;

Der Test läuft 1:1 durch.

Nanu, ich dachte für 64-Bit gäbe es gar keinen Inline-Assembler mehr bei Delphi?

[jbg]

Zitat:

Zitat von NamenLozer (Beitrag 1144910)

Nanu, ich dachte für 64-Bit gäbe es gar keinen Inline-Assembler mehr bei Delphi?

Doch, den gibt es. Man kann aber keinen Inline-Assembler mit Pascal-Funktionen mischen. Es heißt also entweder PurePascal- oder InlineAssembler-Funktion.

[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.

[himitsu]

OK, dann isr das bei dem ONE eine blöde Angelegenheit. :shock:


Aber Int32 für 64 Bit?
Hier meinen doch viele man solle NativeInt verwenden, anstatt Integer, also vorallem bei Pointer-konvertierungen oder wenn man ganze Register nutzen will.




Das

Delphi-Quellcode:

{$IF not Definied()}

geht mindestens seit Delphi 7.
Wie es im FPC aussieht weiß ich nicht.

Zumindestens in Delphi finde ich Typ.Abhängigkeiten ab besser, als Compilerabhängigkeiten. (man weiß ja nie, was die Zukunft bringt)
Auch

Delphi-Quellcode:

{$IF CompilerVersion < 21.0}

empfinde ich besser als ein

Delphi-Quellcode:

{$IFNDEF VER210}

, denn hier ist es nicht so einfach einen "Versionsbereich" zu bestimmen, vorallem wenn man die (neueren) Versionen noch garnicht alle kennt.

[Namenloser]

Hab meinen Code noch mal überarbeitet (s.o.). Sieht auf den ersten Blick länger aus als er eigentlich ist wegen der Inline-Funktionen oben. Ob man es mit Inline-Funktionen oder ohne schöner findet, ist wohl Geschmackssache. Man könnte sie aber auch einfach einmal global definieren, da sie bei solchen Portierungen noch öfter von Nutzen sein könnten. In dem Fall wäre mein Funktionsrumpf dann besonders kompakt :)

Leider ist der Assembler-Code, den der Compiler aus meinem Code erzeugt dafür nicht so kompakt wie bei jbg...

[Assertor]

Guten Morgen!

Bezüglich der Compiler-Defines: Kein Problem, das wird in der neuen DEC sowieso zentral geregelt, jeweils passend für alle Versionen.

Inlined im PurePascal ist so eine Sache, ich hatte schon bei Increment8 mit AddC so meine Probleme mit Delphi 2010, obwohl es unter anderen Versionen läuft: Das steigt der Compiler gerne mal mit einer AV aus. IIRC im QC gemeldet, aber nie so ganz gefixt.

Auf jeden fall nochmals Danke an alle Beteiligten, das ganze war ja jetzt ein kleines DEC FastCode Projekt :thumb:

Ich werde dann hier Feedback geben, jetzt erstmal Arbeiten :)

Viele Grüße
Assertor

[jbg]

Zitat:

Zitat von himitsu (Beitrag 1144957)

Aber Int32 für 64 Bit?

Hier wird mit Daten hantiert, die 32Bit breit sind (Elemente von CRCDef.Table). Warum sollte man da NativeInt verwenden? Um dem 64bit Compiler etwa dazu zu zwingen, Code zu generieren, der ständig 32bit Werte auf 64bit erweitert, um sie im nächsten Schritt wieder auf 32bit zu schrumpfen?

Zitat:

Hier meinen doch viele man solle NativeInt verwenden, anstatt Integer, also vorallem bei Pointer-konvertierungen oder wenn man ganze Register nutzen will.

Hier wird weder eine Pointer-Konvertierung gemacht, noch braucht ein 32bit Wert ein 64bit Register ;-)

Die Variable "Index" könnte man als NativeInt deklarieren, aber das führt auch nur dazu, dass 255 als 8 Byte Wert im OpCode auftaucht und dass sämtliche OpCodes, die Index benutzen, mindestens 1 Byte größer sind ("REX Prefix").

[JasonClark]

Hallo Assertor und alle anderen :hi:

Ich wollte mal ganz kurz anfragen wie es denn nun so aussieht mit den Fortschritten def DEC 6.0 (64bit)?
Glaube ich bin nicht der einzigste der sich tierisch freuen würde endlich auf 64bit damit arbeiten zu können...

Danke für ein kurzes schnelles Statusfeedback im Voraus! :)

[jaenicke]

Wie sieht es denn eigentlich mit dem Projekt aus? 64-Bit wären schon interessant dabei. :wink:

[gammatester]

Ich halte die Konvertierung auf 64-Bit-Assembler für eine Sackgasse. Delphi-64 ist auch ohne ASM für bestimmt 99% aller Cryptoanwendungen schnell genug, überhaupt sind 64-Bit für die meisten DEC-Algos irrelevant. Interressant ist es zB für SHA512 und abgeleitete, siehe zB die Cycles/Byte-Werte für meine Implementationen in der Tabelle.

Im übrigen reicht eine Konvertierung kaum aus; was DEC mM am meisten fehlt sind neue Entwicklungen: CTR, EAX, GCM, CMAC - Modi für die Blockchiffren, neue Stromchiffren wie Salsa/Chacha oder Sosemanuk, die neuen Hashfunktionen SHA512/tt, vom kommenden SHA3/Keccak ganz zu schweigen.

[hugie]

Da es scheinbar kein Feedback gibt, möchte ich doch kurz auf die Alternative DCPcrypt hinweisen.
Läuft angeblich auch mit XE2 und x64.
Werde es heute mal testweise als Ersatz für die DEC einsetzen.

Vg,
Hugie

[bernerbaer]

Zitat:

Zitat von hugie (Beitrag 1202091)

Da es scheinbar kein Feedback gibt, möchte ich doch kurz auf die Alternative DCPcrypt hinweisen.
Läuft angeblich auch mit XE2 und x64.
...

DCPcrypt läuft definitiv auf x64, ich setze es erfolgreich bei XE3 ein.

[gammatester]

DCPcrypt hat eigentlich noch mehr Nachteile als DEC, alles was in meinen letzen Absatz steht, trifft auch auf DCPcrypt zu. Beide werden inhaltlich nicht weiterentwickelt und sind ca 10 Jahre alt.

Bei Klickklack-Technikern allerdings scheint DCPcrypt wegen Installation/Packages beliebt zu sein, diese 'Features' fehlen (sprich: werden nicht benötigt) bei DEC oder meinen Kryptoroutinen (die modular und 64-Bitkompatibel sind, aber Verständnis/Handarbeit benötigen).