(******************************************************************************
* FastPos-Unit. Zusammenarbeit der Delphi-Praxis, FastCode-Challenge und    *
*  dem QuickSearch-Algorithmus von Daniel Sunday                            *
*                                                                            *
* Stellt eine Funktion zum Suchen eines Teilstrings in einem String zur      *
* Verfügung. Dabei wird, in Abhängigkeit der Stringlängen der jeweils beste  *
* Algorithmus ausgewählt                                                    *
* Wenn der Suchstring aus einem Zeichen besteht, wird der Gewinner der      *
* FastCode-Challenge 'CharPos' ([url]www.fastcode.org[/url]) aufgerufen                *
*                                                                            *
* Wenn der Suchstring aus 2 oder 3 Zeichen besteht, oder der zu durchsuchende*
* Text relativ kurz ist, dann wird der Gewinner der FastCode-Challenge 'Pos' *
* aufgerufen.                                                                *
* In allen anderen Fällen wird ein modifizierter QuickSearch-Algorithmus    *
* verwendet, der mit einer Optimierung von Timo Raita arbeitet.              *
*                                                                            *
******************************************************************************)
Unit FastPosUnit;

Interface
Function DPPos(Const sSubStr, sString: String): Integer;
Implementation

Uses
  SysUtils;

Function QPosEx(SearchFor, SearchIn: String; Start: integer): integer;
Asm
               pushad // Alle Register auf Stack legen
          sub esp,$400 // Platz für Skiptabelle schaffen
               // Auf dem Stack liegen folgende Daten
               // ESP : Skiptabelle
               // ESP+$400..$410 : EDI, ESI, EBP, ESP, EBX
               // ESP+$414 : EDX Adresse SearchIn
               // ESP+$418 : ECX Start
               // ESP+$41C : EAX Adresse SearchFor
               // ESP+$420 : EBP
          // ESP+$424 : Returnadresse

               // Prüfen, ob SearchFor oder SearchIn leer ist, oder Start negativ ist
               test eax,eax
               je @Fail // SearchFor ist leer
               test edx,edx
               je @Fail // Searchin ist leer
               mov ebx,[eax-4] // Länge SearchFor
               test ebx,ebx
               je @Fail // SearchFor ist leer
               test ecx,ecx
               js @Fail // Start ist negative

               // Erste und letzte mögliche Fundstelle in ESI bzw. EBP
               je @1
               sub ecx,1 // =Start 0-basierend
@1: lea esi,[edx+ecx] // Ab hier soll gesucht werden
               add edx,[edx-4]
               mov ebp,edx
               sub ebp,ebx // Bis hier soll gesucht werden

               // Prüfen, ob Erste mögliche Fundstelle hinter letzter liegt
               cmp esi,ebp
               ja @Fail

               // Prüfen, ob SearchFor nur 1 Zeichen ist
               // Dann ist keine SkipTabelle erforderlich
          cmp ebx,1
               je @Search1


               // Skiptabelle erstellen
               // 1) for i:=0 to 255 do Skip[i]:=n+1
               mov edi,esp
               mov ecx,$100
               mov eax,ebx
               add eax,1 // Length(Searchfor)+1
               rep stosd
               // 2) For i:=0 To n-1 Do Skip[SearchFor[i]]:=n-i
               mov edi,[esp+$41C] // Adresse SearchFor
               mov eax,ebx // Length(Searchfor)
@FillSkip: movzx edx,[edi+ecx] // SearchFor[i]
               mov [esp+edx*4],eax // Skip[SearchFor[i]]:=n-i
               add ecx,1
               sub eax,1
               jne @FillSkip

               // Erstes und Letztes Zeichen von SearchFor in AL/AH
               mov al,[edi] // Erstes Zeichen SearchFor
               mov ah,[edi+ebx-1] // Letzes Zeichen SearchFor

               // Prüfen, ob Length(SearchFor) > 6 ist
               cmp ebx,6
               ja @SearchX
          jmp @Vector.Pointer[ebx*4-8]
@Vector: dd @Search2
               dd @Search3
               dd @Search4
               dd @Search4 // Länge=5
               dd @Search6

// Länge Searchfor > 6
@SearchX: add edi,1 // Auf zweites Zeichen von SearchFor
               mov [esp+$41C],edi // Merken für CompareMem
               jmp @Search
// Länge SearchFor > 6
@SkipX: mov esi,edx // Aufruf ex CompareMem
@Skip: movzx edx,[esi+ebx]
          add esi,[esp+edx*4]
               cmp esi,ebp
               ja @Fail
@Search: cmp [esi],al
               jne @Skip
               cmp [esi+ebx-1],ah
               jne @Skip
               // Zweites bis vorletzten Zeichen von SearchFor prüfen
               mov edx,esi // ESI retten
               mov edi,[esp+$41C] // Zeiger zweites Zeichen von SearchFor
               add esi,1 // Zeiger Text auf nächstes Zeichen
               mov ecx,ebx // Length(SearchFor)
               sub ecx,2 // -2 (Erstes und letztes Zeichen)
          shr ecx,2 // =Anzahl DWords
               repe cmpsd // DWords vergleichen
               jne @SkipX // Nicht gleich
               mov ecx,ebx // Length(SearchFor)
               sub ecx,2 // -2 (Erstes und letztes Zeichen)
               and ecx,3 // =Anzahl restliche Bytes
               repe cmpsb // Bytes vergleichen
               jne @SkipX // Nicht gleich
               mov esi,edx // Fundstelle
               jmp @Found

// Länge SearchFor=1
@Search1: mov ecx,ebp // Letzte mögliche Fundstelle
               sub ecx,esi // - Erste mögliche Fundstelle
          add ecx,1 // = Anzahl zu prüfende Zeichen
               neg ecx
               sub esi,ecx
               mov al,[eax] // zu suchendes Zeichen
@Loop: cmp al,[esi+ecx]
               je @Found1
               add ecx,1
               jne @Loop
               jmp @Fail
@Found1: lea esi,[esi+ecx] // ESI auf Fundstelle
               jmp @Found

// Länge SearchFor=2
@Skip2: movzx edx,[esi+ebx]
               add esi,[esp+edx*4]
               cmp esi,ebp
               ja @Fail
@Search2: cmp [esi],al
               jne @Skip2
               cmp [esi+ebx-1],ah
               jne @Skip2
               jmp @Found

// Länge SearchFor=3
@Skip3: movzx edx,[esi+ebx]
               add esi,[esp+edx*4]
               cmp esi,ebp
          ja @Fail
@Search3: cmp [esi],al
               jne @Skip3
               cmp [esi+ebx-1],ah
               jne @Skip3
               mov dx,[edi]
               cmp dx,[esi]
               jne @Skip3
               jmp @Found

// Länge SearchFor=4 oder 5
@Skip4: movzx edx,[esi+ebx]
               add esi,[esp+edx*4]
          cmp esi,ebp
               ja @Fail
@Search4: cmp [esi],al
               jne @Skip4
               cmp [esi+ebx-1],ah
               jne @Skip4
               mov edx,[edi]
               cmp edx,[esi]
               jne @Skip4
               jmp @Found

// Länge SearchFor=6
@Skip6: movzx edx,[esi+ebx]
               add esi,[esp+edx*4]
          cmp esi,ebp
               ja @Fail
@Search6: cmp [esi],al
               jne @Skip6
               cmp [esi+ebx-1],ah
               jne @Skip6
               mov edx,[edi+1]
               cmp edx,[esi+1]
               jne @Skip6
               jmp @Found

@Found: // Gefunden, Index berechnen
               sub esi,[esp+$414]
          add esi,1
               jmp @SetRes

@Fail: // Nicht gefunden, Result=0
               xor esi,esi

@SetRes: // Result speichern
               mov [esp+$41C],esi

               // Skiptabelle vom Stack nehmen
               add esp,$400

               // Register wieder herstellen, Result in EAX
               popad
End;

Function CharPos_JOH_SSE2_1_b(Ch: Char; Const Str: AnsiString): Integer;
Asm
  test edx, edx
  jz @@NullString
  mov ecx, [edx-4]
  push ebx
  mov ebx, eax
  cmp ecx, 16
  jl @@Small
@@NotSmall:
  mov ah, al {Fill each Byte of XMM1 with AL}
  movd xmm1, eax
  pshuflw xmm1, xmm1, 0
  pshufd xmm1, xmm1, 0
@@First16:
  movups xmm0, [edx] {Unaligned}
  pcmpeqb xmm0, xmm1 {Compare First 16 Characters}
  pmovmskb eax, xmm0
  test eax, eax
  jnz @@FoundStart {Exit on any Match}
  cmp ecx, 32
  jl @@Medium {If Length(Str) < 32, Check Remainder}
@@Align:
  sub ecx, 16 {Align Block Reads}
  push ecx
  mov eax, edx
  neg eax
  and eax, 15
  add edx, ecx
  neg ecx
  add ecx, eax
@@Loop:
  movaps xmm0, [edx+ecx] {Aligned}
  pcmpeqb xmm0, xmm1 {Compare Next 16 Characters}
  pmovmskb eax, xmm0
  test eax, eax
  jnz @@Found {Exit on any Match}
  add ecx, 16
  jle @@Loop
  pop eax {Check Remaining Characters}
  add edx, 16
  add eax, ecx {Count from Last Loop End Position}
  jmp dword ptr [@@JumpTable2-ecx*4]
  nop
  nop
@@NullString:
  xor eax, eax {Result = 0}
  ret
  nop
@@FoundStart:
  bsf eax, eax {Get Set Bit}
  pop ebx
  inc eax {Set Result}
  ret
  nop
  nop
@@Found:
  pop edx
  bsf eax, eax {Get Set Bit}
  add edx, ecx
  pop ebx
  lea eax, [eax+edx+1] {Set Result}
  ret
@@Medium:
  add edx, ecx {End of String}
  mov eax, 16 {Count from 16}
  jmp dword ptr [@@JumpTable1-64-ecx*4]
  nop
  nop
@@Small:
  add edx, ecx {End of String}
  xor eax, eax {Count from 0}
  jmp dword ptr [@@JumpTable1-ecx*4]
  nop
@@JumpTable1:
  dd @@NotFound, @@01, @@02, @@03, @@04, @@05, @@06, @@07
  dd @@08, @@09, @@10, @@11, @@12, @@13, @@14, @@15, @@16
@@JumpTable2:
  dd @@16, @@15, @@14, @@13, @@12, @@11, @@10, @@09, @@08
  dd @@07, @@06, @@05, @@04, @@03, @@02, @@01, @@NotFound
@@16:
  add eax, 1
  cmp bl, [edx-16]
  je @@Done
@@15:
  add eax, 1
  cmp bl, [edx-15]
  je @@Done
@@14:
  add eax, 1
  cmp bl, [edx-14]
  je @@Done
@@13:
  add eax, 1
  cmp bl, [edx-13]
  je @@Done
@@12:
  add eax, 1
  cmp bl, [edx-12]
  je @@Done
@@11:
  add eax, 1
  cmp bl, [edx-11]
  je @@Done
@@10:
  add eax, 1
  cmp bl, [edx-10]
  je @@Done
@@09:
  add eax, 1
  cmp bl, [edx-9]
  je @@Done
@@08:
  add eax, 1
  cmp bl, [edx-8]
  je @@Done
@@07:
  add eax, 1
  cmp bl, [edx-7]
  je @@Done
@@06:
  add eax, 1
  cmp bl, [edx-6]
  je @@Done
@@05:
  add eax, 1
  cmp bl, [edx-5]
  je @@Done
@@04:
  add eax, 1
  cmp bl, [edx-4]
  je @@Done
@@03:
  add eax, 1
  cmp bl, [edx-3]
  je @@Done
@@02:
  add eax, 1
  cmp bl, [edx-2]
  je @@Done
@@01:
  add eax, 1
  cmp bl, [edx-1]
  je @@Done
@@NotFound:
  xor eax, eax
  pop ebx
  ret
@@Done:
  pop ebx
End;

Procedure Filler2;
Asm
 nop
End;

Function Pos_JOH_IA32_6(Const SubStr: AnsiString; Const Str: AnsiString): Integer;
Asm {Slightly Cut-Down version of PosEx_JOH_6}
  push ebx
  cmp eax, 1
  sbb ebx, ebx {-1 if SubStr = '' else 0}
  sub edx, 1 {-1 if S = ''}
  sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0}
  jl @@InvalidInput
  push edi
  push esi
  push ebp
  push edx
  mov edi, [eax-4] {Length(SubStr)}
  mov esi, [edx-3] {Length(S)}
  cmp edi, esi
  jg @@NotFound {Offset to High for a Match}
  test edi, edi
  jz @@NotFound {Length(SubStr = 0)}
  lea ebp, [eax+edi] {Last Character Position in SubStr + 1}
  add esi, edx {Last Character Position in S}
  movzx eax, [ebp-1] {Last Character of SubStr}
  add edx, edi {Search Start Position in S for Last Character}
  mov ah, al
  neg edi {-Length(SubStr)}
  mov ecx, eax
  shl eax, 16
  or ecx, eax {All 4 Bytes = Last Character of SubStr}
@@MainLoop:
  add edx, 4
  cmp edx, esi
  ja @@Remainder {1 to 4 Positions Remaining}
  mov eax, [edx-4] {Check Next 4 Bytes of S}
  xor eax, ecx {Zero Byte at each Matching Position}
  lea ebx, [eax-$01010101]
  not eax
  and eax, ebx
  and eax, $80808080 {Set Byte to $80 at each Match Position else $00}
  jz @@MainLoop {Loop Until any Match on Last Character Found}
  bsf eax, eax {Find First Match Bit}
  shr eax, 3 {Byte Offset of First Match (0..3)}
  lea edx, [eax+edx-3] {Address of First Match on Last Character + 1}
@@Compare:
  cmp edi, -4
  jle @@Large {Lenght(SubStr) >= 4}
  cmp edi, -1
  je @@SetResult {Exit with Match if Lenght(SubStr) = 1}
  movzx eax, word ptr [ebp+edi] {Last Char Matches - Compare First 2 Chars}
  cmp ax, [edx+edi]
  jne @@MainLoop {No Match on First 2 Characters}
@@SetResult: {Full Match}
  lea eax, [edx+edi] {Calculate and Return Result}
  pop edx
  pop ebp
  pop esi
  pop edi
  pop ebx
  sub eax, edx {Subtract Start Position}
  ret
@@NotFound:
  pop edx {Dump Start Position}
  pop ebp
  pop esi
  pop edi
@@InvalidInput:
  pop ebx
  xor eax, eax {No Match Found - Return 0}
  ret
@@Remainder: {Check Last 1 to 4 Characters}
  mov eax, [esi-3] {Last 4 Characters of S - May include Length Bytes}
  xor eax, ecx {Zero Byte at each Matching Position}
  lea ebx, [eax-$01010101]
  not eax
  and eax, ebx
  and eax, $80808080 {Set Byte to $80 at each Match Position else $00}
  jz @@NotFound {No Match Possible}
  lea eax, [edx-4] {Check Valid Match Positions}
  cmp cl, [eax]
  lea edx, [eax+1]
  je @@Compare
  cmp edx, esi
  ja @@NotFound
  lea edx, [eax+2]
  cmp cl, [eax+1]
  je @@Compare
  cmp edx, esi
  ja @@NotFound
  lea edx, [eax+3]
  cmp cl, [eax+2]
  je @@Compare
  cmp edx, esi
  ja @@NotFound
  lea edx, [eax+4]
  jmp @@Compare
@@Large:
  mov eax, [ebp-4] {Compare Last 4 Characters of S and SubStr}
  cmp eax, [edx-4]
  jne @@MainLoop {No Match on Last 4 Characters}
  mov ebx, edi
@@CompareLoop: {Compare Remaining Characters}
  add ebx, 4 {Compare 4 Characters per Loop}
  jge @@SetResult {All Characters Matched}
  mov eax, [ebp+ebx-4]
  cmp eax, [edx+ebx-4]
  je @@CompareLoop {Match on Next 4 Characters}
  jmp @@MainLoop {No Match}
End;

Function DPPos(Const sSubStr, sString: String): Integer;
Var
  i: Integer;
  c: Char;
Begin
  Case Length(sSubStr) Of
    0:
      Result := 0;
    1:
      Result := CharPos_JOH_SSE2_1_b(sSubStr[1], sString);
    2, 3:
      Result := Pos_JOH_IA32_6(sSubStr, sString);
  Else
    If Length(sString) < 1000 Then // 1000 is ne Hausnummer
      Result := Pos_JOH_IA32_6(sSubStr, sString)
    Else
      Result := QPosEx(sSubStr, sString,1); // Dann kann man auf das '(n<3) or' verzichten!
  End
End;
End.