Boyer Moore Algorithmus

[Ginko]

Ja klar.

[Horst_]

Hallo,

die Asm Version hat ja einfach die Paramter vertauscht
SearchIn Searchfor und Suchtext,SuchWort... -> muss ja 0 werden.
Also EAX und EDX im zu Beginn ander sbehandeln, wieso habe ich nicht einfach ein
XCHG EAX,EDX davorgesetet....

Ich würde in der ASM Version mal an repne scasb //scasw in Betracht ziehen.
Bei Jaenicke's Version
http://www.entwickler-ecke.de/topic_..._91942,20.html , bringt es einiges ab 7 Buchstaben Abstand.

Hier die angepasste Unit1 für Version 5b.

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}
{$ASMMODE INTEL}
interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  strutils, Windows, SpeedSearchExt, BMH_CountStr;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ComboBox1: TComboBox;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.lfm}

{ TForm1 }

const
  testtxt: string = 'Franz jagt im komplett verwahrlosten Taxi quer durch Bayern.' +
    #13#10;

var
  //Variablen für Zeittest
  freq: int64;
  startTime: int64;
  endTime: int64;
//ASM_ERGEBNIS_ASM : integer;

function CountStr(const SearchIn, SearchFor: string): integer; assembler;
      {$DEFINE ANSI}
asm
         TEST    EDX,EDX
         JE      @Ret // SearchFor leer
         mov     ECX,[EDX-4] // Length(SearchFor)
         PUSH    EBP
         PUSH    EBX
         PUSH    EDI
         PUSH    ESI

         PUSH    Dword 0 // Anzahl Zeichen
         //         MOV     ESI,0 ; MOV     ASM_ERGEBNIS_ASM,ESI

         TEST    EAX,EAX
         JE      @end // SearchIn leer
         mov     EBP,ECX // Length(SearchFor)
         MOV     EBX,[EAX-4] // Length(SearchIn)
         SUB     EBX,ECX // Length(SearchIn)-Length(SearchFor)
         JC      @end // SearchFor länger als SearchIn
      {$IFDEF ANSI}
         lea     ESI,[EDX+ECX] // Hinter SearchFor
         LEA     EDI,[EAX+ECX] // Hinter SearchIn[Length(SearchFor)]
      {$ELSE}
         LEA     ESI,[EDX+ECX*2] // Hinter SearchFor
         LEA     EDI,[EAX+ECX*2] // Hinter SearchIn[Length(SearchFor)]
      {$ENDIF}
         NEG     ECX
         JMP     @Entry
         @NextStart:
         SUB     EBX,1
         JC      @end // Alles durchsucht
      {$IFDEF ANSI}
         add EDI,1 // Nächste Startposition
      {$ELSE}
         ADD     EDI,2 // Nächste Startposition
      {$ENDIF}
         @Entry:
         MOV     EDX,ECX // Count
         @CharLoop:
      {$IFDEF ANSI}
         MOV     AL,[ESI+EDX*1] // SearchFor[edx]
         CMP     AL,[EDI+EDX*1] // SearchIn[edx]
      {$ELSE}
         MOV     AX,[ESI+EDX*2] // SearchFor[edx]
         CMP     AX,[EDI+EDX*2] // SearchIn[edx]
      {$ENDIF}
         JNE     @NextStart
         @NextChar:
         ADD     EDX,1 // Count
         JL      @CharLoop // nächstes Zeichen prüfen

         ADD    DWORD PTR [ESP],1 // Anzahl Fundstellen
         //INC     ASM_ERGEBNIS_ASM

     {$IFDEF ANSI}
         LEA     EDI,[EDI+EBP*1] // Um Length(SearchFor) weiter
     {$ELSE}
         LEA     EDI,[EDI+EBP*2] // Um Length(SearchFor) weiter
     {$ENDIF}
         SUB     EBX,EBP // Anzahl verfügbarer Zeichen
         JNC     @Entry // Noch Zeichen da
         @end:
         POP     EAX
         //         MOV     EAX,ASM_ERGEBNIS_ASM

         POP     ESI
         POP     EDI
         POP     EBX
         POP     EBP
         @Ret:
end;
{$UNDEF ANSI}

function CountWordsStd(const Text, wort: string): integer;
var
  i: integer;
begin  //Mit Standard PosEx zählen
  i := 1;
  Result := 0;
  repeat
    i := PosEx(wort, Text, i) + 1;
    if i > 1 then
      Inc(Result)
    else
      exit;
  until False;
end;


procedure TForm1.Button2Click(Sender: TObject); //Test starten
var
  Filestream: TFileStream;
  SuchWort, SuchText: string;
  i, Ergebnis, Durchlaeufe: integer;
begin
  SuchWort := ComboBox1.Text;
  Durchlaeufe := StrToInt(Edit3.Text);

  if not FileExists(ExtractFilePath(Application.ExeName) + '\test.txt') then
  begin
    ShowMessage('Erst Testdatei mit Button "Create TesFile" erstellen !');
    exit;
  end;

  Filestream := TFileStream.Create('test.txt', fmOpenRead);
  try
    SetLength(SuchText, Filestream.Size);
    Filestream.Read(SuchText[1], Length(SuchText));

    QueryPerformanceFrequency(freq);

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start BMH
    for i := 1 to Durchlaeufe do
      Ergebnis := BMH_CountStr_1(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('BMH Count:         ' + IntToStr(Ergebnis) +
      ' in ' + IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start SpeedSearch
    for i := 1 to Durchlaeufe do
      Ergebnis := SpeedSearch(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('SP Search Count: ' + IntToStr(Ergebnis) + ' in ' +
      IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start Standard PosEx
    for i := 1 to Durchlaeufe do
      Ergebnis := CountWordsStd(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('Std PosEx Count: ' + IntToStr(Ergebnis) + ' in ' +
      IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

    //------------------------------------------------------------------------------
    QueryPerformanceCounter(startTime);//start Standard PosEx
    for i := 1 to Durchlaeufe do
      Ergebnis := CountStr(SuchText, SuchWort);
    QueryPerformanceCounter(endTime);//stop

    Memo1.Lines.Add('Asm        Count: ' + IntToStr(Ergebnis) + ' in ' + IntToStr(
      (endTime - startTime) * 1000 div freq) + 'ms');
    Memo1.Lines.Add('');
    //------------------------------------------------------------------------------


  finally
    Filestream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Button3Click(Sender: TObject); //Testdatei erstellen
var
  Filestream: TFileStream;
  i, zeilen: integer;
begin
  zeilen := StrToInt(Edit2.Text);

  Filestream := TFileStream.Create('test.txt', fmCreate);
  try
    for i := 1 to zeilen do
      Filestream.Write(testtxt[1], Length(testtxt));
  finally
    Filestream.Free;
  end;
end;


end.

Das Motorrad ruft ....schon wieder

Gruß Horst

[Ginko]

Ahh ja jetzt läufts, Danke euch! Sehr schön. Besonders bei sehr langen Strings und bei einem Buchstaben liegt die ASM Version bei meinen Tests vorne. Teilweise nochmal doppelt so schnell wie der BMH . Im Mittelfeld allerdings ist der BMH noch vorne.

[Amateurprofi]

Zitat von Horst_:

Ich würde in der ASM Version mal an repne scasb //scasw in Betracht ziehen.

Ich nicht!
Zumindest bei mir ist das langsamer, als konventionelles Cmp
Und das war bei mir schon immer so, beim 80486,Pentium, Pentium II, Core 2 und jetzt Core I7.
Bei anderen CPUs mag das anders sein.
Ich meide all diese schönen Super-Instrutionen wie Cmps, Lods, Scas, Stos, Loop.
Die sind zwar schön bequem, aber langsamer.

Hier mal ein kleines Test-Szenario, das in 800 Bytes erfolglos sucht.
Es wird 1000 Mal getestet wie viel CPU-Ticks Repne Scasb und Cmp brauchen.
Die jeweiligen Minimum-Ticks werden gegenübergestellt.
Bei mir ergab sich für Repne Scasb 3526 Ticks, für konventionelles Cmp 3468 Ticks.
Kein großer Unterschied, aber jedenfalls ein Unterschied zu Gunsten Cmp.

Delphi-Quellcode:

PROCEDURE TestRepneScas(var T1,T2:Int64);
const len=800;
asm
         // Register sichern
         push     ebp
         push     ebx
         push     edi
         push     esi
         // Parameter sichern
         push     eax                     // @T1
         push     edx                     // @T2
         // Len Bytes auf Stack reservieren und mit 0 füllen
         sub      esp,len
         mov      ecx,len
         lea      edx,[esp+ecx]
         neg      ecx
@L1:     mov      byte[edx+ecx],0
         add      ecx,1
         jl       @L1
         // repnw Scasb testen
         rdtsc
         mov      ebp,eax                 // TSC.Lo
         mov      ebx,edx                 // TSC.Hi
         mov      ecx,len                 // Anzahl Bytes
         mov      edi,esp                 // Ab hier prüfen
         mov      al,1                    // 1 suchen (wird nicht gefunden
         repne    scasb
         rdtsc
         sub      eax,ebp
         sbb      edx,ebx
         mov      ebp,eax                 // Ticks für Repne Scas byte
         mov      ebx,edx
         // konventionelle Schleife
         rdtsc
         mov      edi,eax
         mov      esi,edx
         mov      ecx,len                 // Anzahl Bytes
         lea      edx,[esp+ecx]
         neg      ecx
         mov      al,1
@L2:     cmp      [edx+ecx],al
         je       @Found                  // wird nicht eintreten
         add      ecx,1
         jl       @L2
@Found:  rdtsc
         sub      eax,edi                 // Ticks für konventionelles cmp byte
         sbb      edx,esi
         // Len Bytes auf Stack freigeben
         add      esp,len
         pop      ecx                     // @T2
         mov      [ecx],eax               // T2.Lo
         mov      [ecx+4],edx             // T2.Hi
         pop      ecx                     // @T1
         mov      [ecx],ebp               // T1.Lo
         mov      [ecx+4],ebx             // T1.Hi
         // Register wiederherstellen
         pop      esi
         pop      edi
         pop      ebx
         pop      ebp
end;

Delphi-Quellcode:

PROCEDURE TMain.Test;
const count=1000;
var samask,pamask,tamask:NativeUInt;
    t1,t2,ticks1,ticks2:Int64; i:integer; s:string;
begin
   i:=Pos('a',s);
   // Thread auf 1 CPU fixieren
   GetProcessAffinityMask(GetCurrentProcess,pamask,samask);
   if pamask=0 then exit;
   tamask:=1;
   while tamask and pamask=0 do tamask:=tamask shl 1;
   SetThreadAffinityMask(GetCurrentThread,tamask);
   ticks1:=High(Int64);
   ticks2:=High(Int64);
   for i:=1 to count do begin
      TestRepneScas(t1,t2);
      if t1<ticks1 then ticks1:=t1;
      if t2<ticks2 then ticks2:=t2;
   end;
   ShowMessage('Repne Scas: '+IntToStr(ticks1)+' Ticks'#13+
               'Konv. CMP: '+IntToStr(ticks2)+' Ticks'#13+
               'Delta: '+IntToStr(ticks1-ticks2)+' Ticks');
end;