Hilfe: Schnellste möglichkeit ein 4-Byte Array zu Sortieren

[Bjoerk]

Hallo Horst,

ich bezog mich hier auf die in #15 von TE angegeben Rechenzeiten. Sind alle viel zu groß. Deshalb auch meine Frage bezüglich der aufrufenden procedure.

// Edit: Dort gings noch um 5 mill. Durchläufe..

[Horst_]

Hallo,

mit konstantem Wert getestet wie TE Dano un verglichen.
Die Laufzeitunterschiede sind ja gewaltig von der CPU abhängig.
Selbst wenn ich die Dummy-Zeiten draufaddiere, was ja so auch nicht ganz richtig ist, aber auch bei der Anzahl der Durchläufe wohl auch nicht bemerkbar ist, ergeben sich gewaltige Unterschiede, die über die Prozessortaktfrequenzunterschiede von 4% weit hinausgehen.
In Rot AMD x% schneller in schwarz AMD x% langsamer.



Gruß Horst

[himitsu]

Mit einem konstanten Wert bevorteilst und benachteilst du bestimmte Algortihmen, welche gerade bei diesem Wert ihre meisten Verleiche und Verschiebeaktionen hätten.
Die Resultate sind also absolut nicht aussafähig, denn schließlich hat du damit ja 95,8333% aller Möglichkeiten ignoriert.

Die Variante vorher ein Array mit Testwerten zu erstellen, hatte ich ja schonmal vorgeschlagen, das würde allen Algorithmen die selben Testwerte geben, ohne sie live zu berechnen.

[Bjoerk]

Horst, kannst du hier mal die asm routinen einbauen und testen? Wenn du mehr als 1 bis 2 Sekunden einsparst, wäre das m.E. schon ziemlich genial.

Delphi-Quellcode:

unit uArrayOfByteList;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TArrayOfByte = packed record
    case boolean of
      true: (A: array[0..3] of Byte);
      false: (Card: Cardinal);
  end;

  TArrayOfByteList = class(TList)
  private
    function GetItem(Index: integer): TArrayOfByte;
    procedure SetItem(Index: integer; const Value: TArrayOfByte);
  public
    procedure AddItem(const Value: TArrayOfByte);
    procedure DelItem(Index: integer);
    function Networksort(Index: integer): TArrayOfByte;
    function Selectionsort(Index: integer): TArrayOfByte;
    procedure SelectionsortASM(var A: TArrayOfByte);
    procedure SelectionsortASM2(var A: TArrayOfByte);
    procedure SelectionsortASM2Horst(var A: TArrayOfByte);
    procedure SelectionsortASM3Horst(var A: TArrayOfByte);
    property Item[Index: integer]: TArrayOfByte read GetItem write SetItem; default;
    destructor Destroy; override;
  end;

  TWaitTime = class
  private
    FStartTime: TDateTime;
    FWaitTime: int64;
  public
    procedure Start;
    procedure Stop;
    property WaitTime: int64 read FWaitTime;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  ArrayOfByteList: TArrayOfByteList;
  WaitTime: TWaitTime;

implementation

{$R *.dfm}

{ TArrayOfByteList }

function TArrayOfByteList.GetItem(Index: integer): TArrayOfByte;
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  Result:= P^;
end;

procedure TArrayOfByteList.SetItem(Index: integer; const Value: TArrayOfByte);
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  P^:= Value;
end;

procedure TArrayOfByteList.AddItem(const Value: TArrayOfByte);
var
  P: ^TArrayOfByte;
begin
  New(P);
  P^:= Value;
  Add(P);
end;

procedure TArrayOfByteList.DelItem(Index: integer);
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  Dispose(P);
  Delete(Index);
end;

destructor TArrayOfByteList.Destroy;
begin
  while Count > 0 do DelItem(Count-1);
  inherited Destroy;
end;

function TArrayOfByteList.Selectionsort(Index: integer): TArrayOfByte;
  procedure Exchange(const I, J: integer);
  var
    T: byte;
  begin
    T:= Result.A[I];
    Result.A[I]:= Result.A[J];
    Result.A[J]:= T;
  end;
begin
  Result:= Item[Index];
  if Result.A[0] < Result.A[1] then Exchange(0, 1);
  if Result.A[0] < Result.A[2] then Exchange(0, 2);
  if Result.A[0] < Result.A[3] then Exchange(0, 3);
  if Result.A[1] < Result.A[2] then Exchange(1, 2);
  if Result.A[1] < Result.A[3] then Exchange(1, 3);
  if Result.A[2] < Result.A[3] then Exchange(2, 3);
end;

function TArrayOfByteList.Networksort(Index: integer): TArrayOfByte;
  procedure Exchange(const I, J: integer);
  var
    T: byte;
  begin
    T:= Result.A[I];
    Result.A[I]:= Result.A[J];
    Result.A[J]:= T;
  end;
begin
  Result:= Item[Index];
  if Result.A[0] < Result.A[1] then Exchange(0, 1);
  if Result.A[2] < Result.A[3] then Exchange(2, 3);
  if Result.A[0] < Result.A[2] then Exchange(0, 2);
  if Result.A[1] < Result.A[3] then Exchange(1, 3);
  if Result.A[1] < Result.A[2] then Exchange(1, 2);
end;

procedure TArrayOfByteList.SelectionsortASM(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM2(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM2Horst(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM3Horst(var A: TArrayOfByte); assembler;
asm
  //
end;

{ TWaitTime }

procedure TWaitTime.Start;
begin
  FStartTime:= Now;
end;

procedure TWaitTime.Stop;
var
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(Now - FStartTime, Hour, Min, Sec, MSec);
  FWaitTime:= MSec + Sec * 1000 + Min * 60000 + Hour * 3600000;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
    A:= ArrayOfByteList.Selectionsort(I);
  WaitTime.Stop;
  ShowMessage('Selectionsort: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
    A:= ArrayOfByteList.Networksort(I);
  WaitTime.Stop;
  ShowMessage('Networksort: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM2(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM2: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM2Horst(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM2Horst: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM3Horst(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM3Horst: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I, J: integer;
  A: TArrayOfByte;
begin
  Randomize;
  WaitTime:= TWaitTime.Create;
  ArrayOfByteList:= TArrayOfByteList.Create;
  for I:= 1 to MaxInt div 32 do
  begin
    for J:= 0 to 3 do
      A.A[J]:= Random(256);
    ArrayOfByteList.AddItem(A);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ArrayOfByteList.Free;
  WaitTime.Free;
end;

end.

[Dano]

procedure SelectionsortASMDown(var A: Cardinal); register; vieleicht kannst du die proceduren mal mit "register" angeben, weil dann der compiler vor dem aufruf der procedur ein LEA (Load Effective Adress) nach EAX macht... und dann sollten die geposteten ASM-Proceduren eigentlich funktionieren

Delphi-Quellcode:

procedure TArrayOfByteList.SelectionsortASM(var A: TArrayOfByte); register;
label Weiter1,Weiter2,Weiter3,Weiter4,Weiter5,Weiter6;
asm
  // In einer asm-Anweisung muss der Inhalt der Register
  // EDI, ESI, ESP, EBP und EBX erhalten bleiben, während die Register
  // EAX, ECX und EDX beliebig geändert werden können.
  mov ECX,[EAX]; // A in ECX
  mov DL,CL;
  rol ECX,8;
  // init fertig
  // if A[0] > A[1] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  cmp DL,CL;
  jnb Weiter1;
  xchg DL,CL;
Weiter1:
  // if A[0] > A[2] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  rol ECX,8
  cmp DL,CL;
  jnb Weiter2;
  xchg DL,CL;
Weiter2:
  // if A[0] > A[3] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  rol ECX,8;
  cmp DL,CL;
  jnb Weiter3;
  xchg DL,CL;
Weiter3:
  // if A[1] > A[3] then begin T:= A[1]; A[1]:= A[2]; A[2]:= T; end;
  rol EDX,8;
  mov DL,CL;
  ror ECX,8;
  cmp DL,CL;
  jnb Weiter4;
  xchg DL,CL;
Weiter4:
  // if A[1] > A[2] then begin T:= A[1]; A[1]:= A[3]; A[3]:= T; end;
  ror ECX,8;
  cmp DL,CL;
  jnb Weiter5;
  xchg DL,CL;
Weiter5:
  // if A[2] > A[3] then begin T:= A[2]; A[2]:= A[3]; A[3]:= T; end;
  rol EDX,8;
  mov DL,CL;
  rol ECX,8;
  cmp DL,CL;
  jnb Weiter6;
  xchg DL,CL;
Weiter6:
  rol EDX,8;
  mov DL,CL;
  mov [EAX],EDX;
end;

hab es selber noch nicht getestet
aber wäre mir jetzt so aufgefallen... nicht das er die var über den stack übergibt

mov ECX,[EAX]; // A in ECX
sagt das er die varieable die an der speicherstelle steht auf die eax zeigt nach ECX kopieren soll... darum [eax]... ist immer eine dereferenzierung so wie bei zeigern/pointern

mfg Dano

[Dano]

@horst

hab deine angehängte zip mal zum laufen gebracht

Code:

MaxRound 100000000

Tests mit Dummy
 Anzahl: 100000000 Ticks: 704506120 ms: 210,968.3
Tests mit Selectionsort3Down
 Anzahl: 100000000 Ticks: 8187710850 ms: 2451,738.3
Tests mit NetworkSort2
 Anzahl: 100000000 Ticks: 7469487830 ms: 2236,678.3
Tests mit SelectionsortASMDown
 Anzahl: 100000000 Ticks: 6598611390 ms: 1975,898.3
Tests mit SelectionsortASMDown2
 Anzahl: 100000000 Ticks: 6523360900 ms: 1953,368.3
Tests mit SelectionsortASMDown2Horst
 Anzahl: 100000000 Ticks: 6242008250 ms: 1869,118.3
Tests mit SelectionsortASMDown3Horst
 Anzahl: 100000000 Ticks: 4513095900 ms: 1351,408.3

ich frag mich jetzt warum deine foo wieder so viel schneller ist^^

[Horst_]

Hallo,

@bjoerk:
In Post 44 ist das doch in der Unit1.zip eingebaut.
Wie dano schrieb, wie er seine Ergebnisse bekam, habe ich ein eine Form1 mit einem Button1 und einem memo1 zusammengeklickt und dann die entstehende unit1 durch diese ersetzt.Dort sind doch die asm Varianten schon drin.

@dano:
Wie ich schon vorher bemerkt habe kann man ab und an durch cmovc Sprünge einsparen.
Wie BUG auch schrieb, kann ein miss"ge"ratener Sprung die ganzen vorgearbeiten Anweisungen (Befehls-pipeline) über den Haufen werfen, dass bedeutet die CPU muss nach dem Sprung von vorne mit der Arbeit beginnen und schon sind 20 Takte weg.
Der Ersatz durch cmov macht aber nur Sinn, wenn der Sprung nicht vorhersagbar, also ohne kurzes Muster, ist.
Ausserdem können die 80586 und später CPUs auf mehrere parallelen Arbeitssträngen arbeiten, wenn man sie lässt.
Beispielsweise:

Delphi-Quellcode:

 MOV BX,AX             
 Xchg BH,BL //1 tauscht CL,CH

 MOV CX,AX;
 SHR EAX,16;
 MOV DX,AX

 Xchg AH,AL //2 tauscht DL,DH

 cmp CH,CL;
 cmovc cx,bx

Der Befehl
MOV BX,AX
Xchg BH,BL //1 tauscht CL,CH
hat bis
cmovc cx,bx
Zeit, ausgeführt zu werden, da sind noch 5 andere Befehle dazwischen.
Die Anordnung der Befehle ist dann von großem Einfluss.

Wenn der Sprung vorhersagbar ist, wenn man zum Beispiel immer den selben Wert verarbeitet, saust die Verarbeitung den richtigen Weg lang, dann ist bei mir asmdown die schnellste Variante, trotz dreier Sprünge.

Mein Bruder hat jetzt einen i5-2500 mit 3,4 Ghz, der hat bei konstanten Wert fast identische Werte wie der Core2 3,33 Ghz von Dir ( Ok skype lief nebenbei, aber das sollten 4 Kernen doch locker schaffen )

Was mich aber wundert, dass die Laufzeit auf Intel und AMD so unterschiedlich sind.
Meist ist doch AMD langsamer.
Bei Dir: 1351 e-3 / 1e8 = 1.351e-8 s pro Aufruf = 1.351e-8 [s]*3,33e9 [Hz] = 45 Cpu Takte.
Ich brauche Anzahl: 2147483646 ms: 14825,648.3 => 14825,64/2147483646*3,2e9 =22 Takte.

Vielleicht hat ja jemand anderer noch eine AMD CPU.
Es kann natürlich sein, dass eine Umstellung der Befehle für die Intel CPU von Vorteil ist.

Zudem könnte man denn letzten Sprung auch noch durch cmovc ersetzen, da die "Strafe" für einen falschen Sprung 20 Takte ist.Bei einer 50/50 Chance der Sprungvorhersage, kann man ruhig noch 8 Takte verbraten

Ich hatte Dir aber schon geschrieben das es mit 6 Vergleichen und der Auswertung des Carry Flags durch eine Sprungtabelle noch schneller sein müsste:

Delphi-Quellcode:

procedure Testvariante(var A: ByteArray);assembler;
{  I  D  C  B  A ECX 
   0  4  3  2  1  63  00111111   ..
   6  4  3  1  2  55  00110111   tausche BA
   2  4  2  3  1  59  00111011   tausche CB
  14  4  1  2  3  35  00100011   tausche CA
  12  4  2  1  3  39  00100111   tausche CA ,BA
   8  4  1  3  2  43  00101011   tausche CB ,BA

   1  3  4  2  1  62  00111110   tausche DC
   4  3  2  4  1  57  00111001   tausche DC ,CB
   7  3  4  1  2  54  00110110   tausche DC ,BA   
  10  3  1  4  2  41  00101001   tausche DC ,BA, DA   
  18  3  2  1  4   7  00000111   tausche DC ,BA, DB
  20  3  1  2  4   3  00000011   tausche DC ,BA, DA

   5  2  3  4  1  56  00111000   
   3  2  4  3  1  60  00111100
  13  2  4  1  3  22  00010110
  16  2  1  4  3   9  00001001
  19  2  3  1  4   6  00000110
  22  2  1  3  4   1  00000001   BSWAP tausche BA


  17  1  2  4  3   8  00001000   BSWAP tausche DC 
  21  1  3  2  4   4  00000100   BSWAP tausche CB
  23  1  2  3  4   0  00000000   BSWAP
   9  1  4  3  2  28  00011100
  11  1  3  4  2  24  00011000
  15  1  4  2  3  20  00010100}
ASM

  PUSH EAX;
  MOV  EAX,Dword PTR [EAX];//  A,B,C,D
  
  MOV  EDX,EAX;        //EDX  A,B ,C,D  DL = A; DH = B
  BSWAP EAX;           //EAX  D,C ,B,A  AL = D; AH = C  
  XOR  ECX,ECX;
    
  CMP  DL,AL;          //A<D  
  RCL  CL,1;
  CMP  DL,AH;          //A<C
  RCL  CL,1;
  CMP  DL,DH;          //A<B
  RCL  CL,1;

  CMP  DH,AH;          //B<C
  RCL  CL,1;
  CMP  DH,AL;          //B<D  
  RCL  CL,1;
  
  CMP  AH,AL;          //C<D
  RCL  CL,1;

  XOR ECX,ECX; // Test
  // Berechneter Sprung
  JMP DWORD PTR [@SprungTabelle+4*ECX]

@L0:
  POP EAX;  
  MOV Dword Ptr[EAX],EDX;
  Ret;
@L1:;//
@L3:;//
//.....
@L63:;//....

@Sprungtabelle:
  DD  @L0,@L1,0,@L3
 .....
end;

Gruß Horst.