Re: Fastcode Library Design

Hi Michael

Try read

http://www.fastcode.dk/fastcodeproject/fastcodeproject/55.htm

> > Just add the library to the project uses clause
> >
> > Pro's and Con's of proposed new library design:-
> >
> > Ease of use (1-5 five is very easy)
> >
> > 3 ??????????????????
>
> For Patching or for Direct Calling ?

Both ?

> > The DKC Math and Strings libraries.
> >
> > Ease of use (1-5 five is very easy)
> >
> > 5
>
> I don't understand this part, do you want to Merge all the
> FastCode functions into 1 unit ? (I can also to that, but

Nope

> it isn't easier to maintain then)

unit FastcodeStringsBlendedUnit;

(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The implementation of functions in this unit is subject to the
* Mozilla Public License Version 1.1 (the "License"); you may
* not use this file except in compliance with the License.
* You may obtain a copy of the License at http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS"
basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is Fastcode
*
* The Initial Developer of the Original Code is Fastcode
*
* Portions created by the Initial Developer are Copyright (C) 2002-2004
* the Initial Developer. All Rights Reserved.
*
* Contributor(s): John O'Harrow and Aleksandr Sharahov
*
* ***** END LICENSE BLOCK ***** *)

//Version 0.2 24-8.2005
//Unit made by Dennis Christensen
//24-8-2005 LowerCase changed from LowerCaseShaAsm4 to LowerCaseShaAsm6
//24-8-2005 StrComp changed from StrCompSha6 to StrCompSha7

interface

uses
SysUtils;

function CharPos(Ch : Char; const Str : AnsiString) : Integer;
function CharPosEY(const SearchCharacter : Char;
const SourceString : AnsiString;
Occurrence : Integer = 1;
StartPos : Integer = 1): Integer;
function CompareText(const S1, S2: string): Integer;
function LowerCase(const s: string): string;
function Pos(const SubStr: AnsiString; const Str: AnsiString): Integer;
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
function StrComp(const Str1, Str2: PChar): Integer;
function StrCopy(Dest: PChar; const Source: PChar): PChar;
function StringReplace(const S, OldPattern, NewPattern: AnsiString;
Flags: TReplaceFlags): AnsiString;
function UpperCase(const S: string): string;

implementation

var
AnsiUpcase : packed array[Char] of Char;

//Only needed for XXXXXX

{Turn Off Range Checking and Overflow Checking within this Unit}
{$UNDEF RangeCheck}
{$IFOPT R+}
{$R-}
{$DEFINE RangeCheck}
{$ENDIF}
{$UNDEF OverflowCheck}
{$IFOPT Q+}
{$Q-}
{$DEFINE OverflowCheck}
{$ENDIF}

{$DEFINE AllowLengthShortcut} {Use String Header for String Length (2%
Faster)}

{Non-Overlapping Move for Positive Counts}
procedure MoveEx(const Source; var Dest; Count: Integer);
const
SMALLMOVESIZE = 36;
asm
cmp ecx, SMALLMOVESIZE
ja @Large
lea eax, [eax+ecx]
lea edx, [edx+ecx]
jmp dword ptr [@@FwdJumpTable+ecx*4]
@Large:
push ebx
mov ebx,edx
fild qword ptr [eax]
add eax,ecx {QWORD Align Writes}
add ecx,edx
add edx,7
and edx,-8
sub ecx,edx
add edx,ecx {Now QWORD Aligned}
sub ecx,16
neg ecx
@FwdLoop:
fild qword ptr [eax+ecx-16]
fistp qword ptr [edx+ecx-16]
fild qword ptr [eax+ecx-8]
fistp qword ptr [edx+ecx-8]
add ecx,16
jle @FwdLoop
fistp qword ptr [ebx]
neg ecx
add ecx,16
pop ebx
jmp dword ptr [@@FwdJumpTable+ecx*4]
nop
nop {Align Jump Table}
@@FwdJumpTable:
dd @@Done {Removes need to test for zero size Move}
dd @@Fwd01,@@Fwd02,@@Fwd03,@@Fwd04,@@Fwd05,@@Fwd06,@@Fwd07,@@Fwd08
dd @@Fwd09,@@Fwd10,@@Fwd11,@@Fwd12,@@Fwd13,@@Fwd14,@@Fwd15,@@Fwd16
dd @@Fwd17,@@Fwd18,@@Fwd19,@@Fwd20,@@Fwd21,@@Fwd22,@@Fwd23,@@Fwd24
dd @@Fwd25,@@Fwd26,@@Fwd27,@@Fwd28,@@Fwd29,@@Fwd30,@@Fwd31,@@Fwd32
dd @@Fwd33,@@Fwd34,@@Fwd35,@@Fwd36
@@Fwd36:
mov ecx,[eax-36]
mov [edx-36],ecx
@@Fwd32:
mov ecx,[eax-32]
mov [edx-32],ecx
@@Fwd28:
mov ecx,[eax-28]
mov [edx-28],ecx
@@Fwd24:
mov ecx,[eax-24]
mov [edx-24],ecx
@@Fwd20:
mov ecx,[eax-20]
mov [edx-20],ecx
@@Fwd16:
mov ecx,[eax-16]
mov [edx-16],ecx
@@Fwd12:
mov ecx,[eax-12]
mov [edx-12],ecx
@@Fwd08:
mov ecx,[eax-8]
mov [edx-8],ecx
@@Fwd04:
mov ecx,[eax-4]
mov [edx-4],ecx
ret
@@Fwd35:
mov ecx,[eax-35]
mov [edx-35],ecx
@@Fwd31:
mov ecx,[eax-31]
mov [edx-31],ecx
@@Fwd27:
mov ecx,[eax-27]
mov [edx-27],ecx
@@Fwd23:
mov ecx,[eax-23]
mov [edx-23],ecx
@@Fwd19:
mov ecx,[eax-19]
mov [edx-19],ecx
@@Fwd15:
mov ecx,[eax-15]
mov [edx-15],ecx
@@Fwd11:
mov ecx,[eax-11]
mov [edx-11],ecx
@@Fwd07:
mov ecx,[eax-7]
mov [edx-7],ecx
mov ecx,[eax-4]
mov [edx-4],ecx
ret
@@Fwd03:
movzx ecx, word ptr [eax-3]
mov [edx-3],cx
movzx ecx, byte ptr [eax-1]
mov [edx-1],cl
ret
@@Fwd34:
mov ecx,[eax-34]
mov [edx-34],ecx
@@Fwd30:
mov ecx,[eax-30]
mov [edx-30],ecx
@@Fwd26:
mov ecx,[eax-26]
mov [edx-26],ecx
@@Fwd22:
mov ecx,[eax-22]
mov [edx-22],ecx
@@Fwd18:
mov ecx,[eax-18]
mov [edx-18],ecx
@@Fwd14:
mov ecx,[eax-14]
mov [edx-14],ecx
@@Fwd10:
mov ecx,[eax-10]
mov [edx-10],ecx
@@Fwd06:
mov ecx,[eax-6]
mov [edx-6],ecx
@@Fwd02:
movzx ecx, word ptr [eax-2]
mov [edx-2],cx
ret
@@Fwd33:
mov ecx,[eax-33]
mov [edx-33],ecx
@@Fwd29:
mov ecx,[eax-29]
mov [edx-29],ecx
@@Fwd25:
mov ecx,[eax-25]
mov [edx-25],ecx
@@Fwd21:
mov ecx,[eax-21]
mov [edx-21],ecx
@@Fwd17:
mov ecx,[eax-17]
mov [edx-17],ecx
@@Fwd13:
mov ecx,[eax-13]
mov [edx-13],ecx
@@Fwd09:
mov ecx,[eax-9]
mov [edx-9],ecx
@@Fwd05:
mov ecx,[eax-5]
mov [edx-5],ecx
@@Fwd01:
movzx ecx, byte ptr [eax-1]
mov [edx-1],cl
@@Done:
end; {MoveEx}

{Fast Equivalent of Delphi 7 PosEx}
function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
asm
push ebx
push esi
push edx {@Str}
test eax, eax
jz @@NotFound {Exit if SubStr = ''}
test edx, edx
jz @@NotFound {Exit if Str = ''}
mov esi, ecx
mov ecx, [edx-4] {Length(Str)}
mov ebx, [eax-4] {Length(SubStr)}
add ecx, edx
sub ecx, ebx {Max Start Pos for Full Match}
lea edx, [edx+esi-1] {Set Start Position}
cmp edx, ecx
jg @@NotFound {StartPos > Max Start Pos}
cmp ebx, 1 {Length(SubStr)}
jle @@SingleChar {Length(SubStr) <= 1}
push edi
push ebp
lea edi, [ebx-2] {Length(SubStr) - 2}
mov esi, eax
movzx ebx, [eax] {Search Character}
@@Loop: {Compare 2 Characters per Loop}
cmp bl, [edx]
jne @@NotChar1
mov ebp, edi {Remainder}
@@Char1Loop:
movzx eax, word ptr [esi+ebp]
cmp ax, [edx+ebp]
jne @@NotChar1
sub ebp, 2
jnc @@Char1Loop
pop ebp
pop edi
jmp @@SetResult
@@NotChar1:
cmp bl, [edx+1]
jne @@NotChar2
mov ebp, edi {Remainder}
@@Char2Loop:
movzx eax, word ptr [esi+ebp]
cmp ax, [edx+ebp+1]
jne @@NotChar2
sub ebp, 2
jnc @@Char2Loop
pop ebp
pop edi
jmp @@CheckResult
@@NotChar2:
add edx, 2
cmp edx, ecx {Next Start Position <= Max Start Position}
jle @@Loop
pop ebp
pop edi
jmp @@NotFound
@@SingleChar:
jl @@NotFound {Needed for Zero-Length Non-NIL Strings}
movzx eax, [eax] {Search Character}
@@CharLoop:
cmp al, [edx]
je @@SetResult
cmp al, [edx+1]
je @@CheckResult
add edx, 2
cmp edx, ecx
jle @@CharLoop
@@NotFound:
xor eax, eax
pop edx
pop esi
pop ebx
ret
@@CheckResult: {Check within String}
cmp edx, ecx
jge @@NotFound
add edx, 1
@@SetResult:
pop ecx {@Str}
pop esi
pop ebx
neg ecx
lea eax, [edx+ecx+1]
end; {PosEx}

{Non Case Sensitive version of PosEx}
function PosExIgnoreCase(const SubStr, S: string; Offset: Cardinal = 1):
Integer;
asm
push ebx
push esi
push edx {@Str}
test eax, eax
jz @@NotFound {Exit if SubStr = ''}
test edx, edx
jz @@NotFound {Exit if Str = ''}
mov esi, ecx
mov ecx, [edx-4] {Length(Str)}
mov ebx, [eax-4] {Length(SubStr)}
add ecx, edx
sub ecx, ebx {Max Start Pos for Full Match}
lea edx, [edx+esi-1] {Set Start Position}
cmp edx, ecx
jg @@NotFound {StartPos > Max Start Pos}
cmp ebx, 1 {Length(SubStr)}
jle @@SingleChar {Length(SubStr) <= 1}
push edi
push ebp
lea edi, [ebx-2] {Length(SubStr) - 2}
mov esi, eax
push edi {Save Remainder to Check = Length(SubStr) - 2}
push ecx {Save Max Start Position}
lea edi, AnsiUpcase {Uppercase Lookup Table}
movzx ebx, [eax] {Search Character = 1st Char of SubStr}
movzx ebx, [edi+ebx] {Convert to Uppercase}
@@Loop: {Loop Comparing 2 Characters per Loop}
movzx eax, [edx] {Get Next Character}
movzx eax, [edi+eax] {Convert to Uppercase}
cmp eax, ebx
jne @@NotChar1
mov ebp, [esp+4] {Remainder to Check}
@@Char1Loop:
movzx eax, [esi+ebp]
movzx ecx, [edx+ebp]
movzx eax, [edi+eax] {Convert to Uppercase}
movzx ecx, [edi+ecx] {Convert to Uppercase}
cmp eax, ecx
jne @@NotChar1
movzx eax, [esi+ebp+1]
movzx ecx, [edx+ebp+1]
movzx eax, [edi+eax] {Convert to Uppercase}
movzx ecx, [edi+ecx] {Convert to Uppercase}
cmp eax, ecx
jne @@NotChar1
sub ebp, 2
jnc @@Char1Loop
pop ecx
pop edi
pop ebp
pop edi
jmp @@SetResult
@@NotChar1:
movzx eax, [edx+1] {Get Next Character}
movzx eax, [edi+eax] {Convert to Uppercase}
cmp bl, al
jne @@NotChar2
mov ebp, [esp+4] {Remainder to Check}
@@Char2Loop:
movzx eax, [esi+ebp]
movzx ecx, [edx+ebp+1]
movzx eax, [edi+eax] {Convert to Uppercase}
movzx ecx, [edi+ecx] {Convert to Uppercase}
cmp eax, ecx
jne @@NotChar2
movzx eax, [esi+ebp+1]
movzx ecx, [edx+ebp+2]
movzx eax, [edi+eax] {Convert to Uppercase}
movzx ecx, [edi+ecx] {Convert to Uppercase}
cmp eax, ecx
jne @@NotChar2
sub ebp, 2
jnc @@Char2Loop
pop ecx
pop edi
pop ebp
pop edi
jmp @@CheckResult {Check Match is within String Data}
@@NotChar2:
add edx, 2
cmp edx, [esp] {Compate to Max Start Position}
jle @@Loop {Loop until Start Position > Max Start Position}
pop ecx {Dump Start Position}
pop edi {Dump Remainder to Check}
pop ebp
pop edi
jmp @@NotFound
@@SingleChar:
jl @@NotFound {Needed for Zero-Length Non-NIL Strings}
lea esi, AnsiUpcase
movzx ebx, [eax] {Search Character = 1st Char of SubStr}
movzx ebx, [esi+ebx] {Convert to Uppercase}
@@CharLoop:
movzx eax, [edx]
movzx eax, [esi+eax] {Convert to Uppercase}
cmp eax, ebx
je @@SetResult
movzx eax, [edx+1]
movzx eax, [esi+eax] {Convert to Uppercase}
cmp eax, ebx
je @@CheckResult
add edx, 2
cmp edx, ecx
jle @@CharLoop
@@NotFound:
xor eax, eax
pop edx
pop esi
pop ebx
ret
@@CheckResult: {Check Match is within String Data}
cmp edx, ecx
jge @@NotFound
add edx, 1 {OK - Adjust Result}
@@SetResult: {Set Result Position}
pop ecx {@Str}
pop esi
pop ebx
neg ecx
lea eax, [edx+ecx+1]
end; {PosExIgnoreCase}

{Replace all occurance of Old (Ignoring Case) with New in Non-Null String S}
procedure CharReplaceIC(var S: AnsiString; const Old, New: Char);
asm
push ebx
push edi
push esi
mov eax, [eax] {@S}
mov ebx, ecx {bl = New}
lea edi, AnsiUpcase
and edx, $FF {edx = Old}
mov ecx, [eax-4] {Length(S)}
movzx edx, [edx+edi] {edx = Uppercase(Old)}
lea esi, [eax+ecx]
neg ecx
@@Loop:
movzx eax, [esi+ecx] {Next Char}
movzx eax, [eax+edi] {Convert to Uppercase}
cmp eax, edx {Compare Char}
jne @@Next
mov [esi+ecx], bl {Replace Char}
@@Next:
add ecx, 1
jnz @@Loop
pop esi
pop edi
pop ebx
end;

{Replace all occurance of Old (Case Sensitive) with New in Non-Null String
S}
procedure CharReplaceCS(var S: AnsiString; const Old, New: Char);
asm
push ebx
mov eax, [eax] {@S}
mov ebx, ecx {bl = New, dl = Old}
mov ecx, [eax-4] {Length(S)}
add eax, ecx
neg ecx
@@Loop:
cmp dl, [eax+ecx] {Compare Next Char}
jne @@Next
mov [eax+ecx], bl {Replace Char}
@@Next:
add ecx, 1
jnz @@Loop
pop ebx
end;

//Author John O'Harrow
//Original name StringReplaceJOH_IA32_3
//Instructionset(s): IA32

function StringReplace(const S, OldPattern, NewPattern: AnsiString;
Flags: TReplaceFlags): AnsiString;
type
TPosEx = function(const SubStr, S: string; Offset: Cardinal = 1):
Integer;
TCharRep = procedure(var S : AnsiString; const Old, New : Char);
const
InitialBufferSize = 16;
PosExFunction : array[Boolean] of TPosEx = (PosEx, PosExIgnoreCase);
CharReplace : array[Boolean] of TCharRep = (CharReplaceCS,
CharReplaceIC);
var
SrcLen, OldLen, NewLen, Found, Count, Start, Match, BufSize, BufMax :
Integer;
StaticBuffer : array[0..InitialBufferSize-1] of Integer;
Buffer : PIntegerArray;
PSrc, PRes : PChar;
IgnoreCase : Boolean;
begin
{$IFDEF AllowLengthShortcut}
SrcLen := 0;
if (S <> '') then
SrcLen := PCardinal(Cardinal(S)-4)^;
OldLen := 0;
if (OldPattern <> '') then
OldLen := PCardinal(Cardinal(OldPattern)-4)^;
NewLen := 0;
if (NewPattern <> '') then
NewLen := PCardinal(Cardinal(NewPattern)-4)^;
{$ELSE}
SrcLen := Length(S);
OldLen := Length(OldPattern);
NewLen := Length(NewPattern);
{$ENDIF}
if (OldLen = 0) or (SrcLen < OldLen) then
begin
if SrcLen = 0 then
Result := '' {Needed for Non-Nil Zero Length Strings}
else
Result := S
end
else
begin
IgnoreCase := rfIgnoreCase in Flags;
if rfReplaceAll in Flags then
begin
if (NewLen = 1) and (OldLen = 1) then
begin
SetLength(Result, SrcLen);
MoveEx(Pointer(S)^, Pointer(Result)^, SrcLen);
CharReplace[IgnoreCase](Result, OldPattern[1], NewPattern[1]);
Exit;
end;
Found := PosExFunction[IgnoreCase](OldPattern, S, 1);
if Found <> 0 then
begin
Buffer := @StaticBuffer;
BufMax := InitialBufferSize;
BufSize := 1;
Buffer[0] := Found;
repeat
Inc(Found, OldLen);
Found := PosExFunction[IgnoreCase](OldPattern, S, Found);
if Found > 0 then
begin
if BufSize = BufMax then
begin {Create or Expand Dynamic Buffer}
BufMax := BufMax + (BufMax shr 1); {Grow by 50%}
if Buffer = @StaticBuffer then
begin {Create Dynamic Buffer}
GetMem(Buffer, BufMax * SizeOf(Integer));
MoveEx(StaticBuffer, Buffer^,
SizeOf(StaticBuffer));
end
else {Expand Dynamic Buffer}
ReallocMem(Buffer, BufMax * SizeOf(Integer));
end;
Buffer[BufSize] := Found;
Inc(BufSize);
end
until Found = 0;
SetLength(Result, SrcLen + (BufSize * (NewLen - OldLen)));
PSrc := Pointer(S);
PRes := Pointer(Result);
Start := 1;
for Match := 0 to BufSize - 1 do
begin
Found := Buffer[Match];
Count := Found - Start;
Start := Found + OldLen;
if Count > 0 then
begin
MoveEx(PSrc^, PRes^, Count);
Inc(PRes, Count);
end;
Inc(PSrc, Count + OldLen);
MoveEx(Pointer(NewPattern)^, PRes^, NewLen);
Inc(PRes, NewLen);
end;
Dec(SrcLen, Start);
if SrcLen >= 0 then
MoveEx(PSrc^, PRes^, SrcLen + 1);
if BufMax <> InitialBufferSize then
FreeMem(Buffer); {Free Dynamic Buffwe if Created}
end
else {No Matches Found}
Result := S
end
else
begin {Replace First Occurance Only}
Found := PosExFunction[IgnoreCase](OldPattern, S, 1);
if Found <> 0 then
begin {Match Found}
SetLength(Result, SrcLen - OldLen + NewLen);
Dec(Found);
PSrc := Pointer(S);
PRes := Pointer(Result);
if NewLen = OldLen then
begin
MoveEx(PSrc^, PRes^, SrcLen);
Inc(PRes, Found);
MoveEx(Pointer(NewPattern)^, PRes^, NewLen);
end
else
begin
MoveEx(PSrc^, PRes^, Found);
Inc(PRes, Found);
Inc(PSrc, Found + OldLen);
MoveEx(Pointer(NewPattern)^, PRes^, NewLen);
Inc(PRes, NewLen);
MoveEx(PSrc^, PRes^, SrcLen - Found - OldLen);
end;
end
else {No Matches Found}
Result := S
end;
end;
end;

//Author John O'Harrow
//Original name CharPosJOH_MMX
//Instructionset(s): IA32, MMX

function CharPos(Ch : Char; const Str : AnsiString) : Integer;
asm
TEST EDX, EDX {Str = NIL?}
JZ @@NotFound {Yes - Jump}
MOV ECX, [EDX-4] {ECX = Length(Str)}
CMP ECX, 8
JG @@NotSmall
TEST ECX, ECX
JZ @@NotFound {Exit if Length = 0}
@@Small:
CMP AL, [EDX]
JZ @Found1
DEC ECX
JZ @@NotFound
CMP AL, [EDX+1]
JZ @Found2
DEC ECX
JZ @@NotFound
CMP AL, [EDX+2]
JZ @Found3
DEC ECX
JZ @@NotFound
CMP AL, [EDX+3]
JZ @Found4
DEC ECX
JZ @@NotFound
CMP AL, [EDX+4]
JZ @Found5
DEC ECX
JZ @@NotFound
CMP AL, [EDX+5]
JZ @Found6
DEC ECX
JZ @@NotFound
CMP AL, [EDX+6]
JZ @Found7
DEC ECX
JZ @@NotFound
CMP AL, [EDX+7]
JZ @Found8
@@NotFound:
XOR EAX, EAX
RET
@Found1:
MOV EAX, 1
RET
@Found2:
MOV EAX, 2
RET
@Found3:
MOV EAX, 3
RET
@Found4:
MOV EAX, 4
RET
@Found5:
MOV EAX, 5
RET
@Found6:
MOV EAX, 6
RET
@Found7:
MOV EAX, 7
RET
@Found8:
MOV EAX, 8
RET

@@NotSmall: {Length(Str) > 8}
MOV AH, AL
ADD EDX, ECX
MOVD MM0, EAX
PUNPCKLWD MM0, MM0
PUNPCKLDQ MM0, MM0
PUSH ECX {Save Length}
NEG ECX
@@First8:
MOVQ MM1, [EDX+ECX]
ADD ECX, 8
PCMPEQB MM1, MM0 {Compare All 8 Bytes}
PACKSSWB MM1, MM1 {Pack Result into 4 Bytes}
MOVD EAX, MM1
TEST EAX, EAX
JNZ @@Matched {Exit on Match at any Position}
CMP ECX, -8 {Check if Next Loop would pass String End}
JGE @@Last8
@@Align: {Align to Previous 8 Byte Boundary}
LEA EAX, [EDX+ECX]
AND EAX, 7 {EAX -> 0 or 4}
SUB ECX, EAX
@@Loop:
MOVQ MM1, [EDX+ECX]
ADD ECX, 8
PCMPEQB MM1, MM0 {Compare All 8 Bytes}
PACKSSWB MM1, MM1 {Pack Result into 4 Bytes}
MOVD EAX, MM1
TEST EAX, EAX
JNZ @@Matched {Exit on Match at any Position}
CMP ECX, -8 {Check if Next Loop would pass String End}
{$IFNDEF NoUnroll}
JGE @@Last8
MOVQ MM1, [EDX+ECX]
ADD ECX, 8
PCMPEQB MM1, MM0 {Compare All 8 Bytes}
PACKSSWB MM1, MM1 {Pack Result into 4 Bytes}
MOVD EAX, MM1
TEST EAX, EAX
JNZ @@Matched {Exit on Match at any Position}
CMP ECX, -8 {Check if Next Loop would pass String End}
{$ENDIF}
JL @@Loop
@@Last8:
MOVQ MM1, [EDX-8] {Position for Last 8 Used Characters}
POP EDX {Original Length}
PCMPEQB MM1, MM0 {Compare All 8 Bytes}
PACKSSWB MM1, MM1 {Pack Result into 4 Bytes}
MOVD EAX, MM1
TEST EAX, EAX
JNZ @@Matched2 {Exit on Match at any Position}
EMMS
RET {Finished - Not Found}
@@Matched: {Set Result from 1st Match in EDX}
POP EDX {Original Length}
ADD EDX, ECX
@@Matched2:
EMMS
SUB EDX, 8 {Adjust for Extra ADD ECX,8 in Loop}
TEST AL, AL
JNZ @@MatchDone {Match at Position 1 or 2}
TEST AH, AH
JNZ @@Match1 {Match at Position 3 or 4}
SHR EAX, 16
TEST AL, AL
JNZ @@Match2 {Match at Position 5 or 6}
SHR EAX, 8
ADD EDX, 6
JMP @@MatchDone
@@Match2:
ADD EDX, 4
JMP @@MatchDone
@@Match1:
SHR EAX, 8 {AL <- AH}
ADD EDX, 2
@@MatchDone:
XOR EAX, 2
AND EAX, 3 {EAX <- 1 or 2}
ADD EAX, EDX
end;

//Author John O'Harrow
//Original name CharPosEY_JOH_IA32_4
//Instructionset(s): IA32

{Can Read DWORD containing NULL Charatcer}
function CharPosEY(const SearchCharacter : Char;
const SourceString : AnsiString;
Occurrence : Integer = 1;
StartPos : Integer = 1): Integer;
asm
test edx, edx
jz @@NotFoundExit {Exit if SourceString = ''}
cmp ecx, 1
jl @@NotFoundExit {Exit if Occurence < 1}
mov ebp, StartPos {Safe since EBP automatically saved}
sub ebp, 1
jl @@NotFoundExit {Exit if StartPos < 1}
push ebx
add ebp, edx
mov ebx, [edx-4]
add ebx, edx
sub ebp, ebx
jge @@NotFound {Traps Zero Length Non-Nil String}
@@Loop:
cmp al, [ebx+ebp]
je @@Check1
@@Next:
cmp al, [ebx+ebp+1]
je @@Check2
@@Next2:
cmp al, [ebx+ebp+2]
je @@Check3
@@Next3:
cmp al, [ebx+ebp+3]
je @@Check4
@@Next4:
add ebp, 4
jl @@Loop
@@NotFound:
pop ebx
@@NotFoundExit:
xor eax, eax
jmp @@Exit
@@Check4:
sub ecx, 1
jnz @@Next4
add ebp, 3
jge @@NotFound
jmp @@SetResult
@@Check3:
sub ecx, 1
jnz @@Next3
add ebp, 2
jge @@NotFound
jmp @@SetResult
@@Check2:
sub ecx, 1
jnz @@Next2
add ebp, 1
jge @@NotFound
jmp @@SetResult
@@Check1:
sub ecx, 1
jnz @@Next
@@SetResult:
lea eax, [ebx+ebp+1]
sub eax, edx
pop ebx
@@Exit:
end;

//Author Aleksandr Sharahov
//Original name CompareTextShaAsm3
//Instructionset(s): IA32

function CompareText(const S1, S2: string): Integer;
asm
test eax, eax
jz @nil1
test edx, edx
jnz @ptrok

@nil2: mov eax, [eax-4]
ret
@nil1: test edx, edx
jz @nil0
sub eax, [edx-4]
@nil0: ret

@ptrok: push edi
push ebx
xor edi, edi
mov ebx, [eax-4]
mov ecx, ebx
sub ebx, [edx-4]
adc edi, -1
push ebx
and ebx, edi
mov edi, eax
sub ebx, ecx
jge @len

@lenok: sub edi, ebx
sub edx, ebx

@loop: mov eax, [ebx+edi]
mov ecx, [ebx+edx]
cmp eax, ecx
jne @byte0
@same: add ebx, 4
jl @loop

@len: pop eax
pop ebx
pop edi
ret

@loop2: mov eax, [ebx+edi]
mov ecx, [ebx+edx]
cmp eax, ecx
je @same

@byte0: cmp al, cl
je @byte1

and eax, $FF
and ecx, $FF
sub eax, 'a'
sub ecx, 'a'
cmp al, 'z'-'a'
ja @up0a
sub eax, 'a'-'A'
@up0a: cmp cl, 'z'-'a'
ja @up0c
sub ecx, 'a'-'A'
@up0c: sub eax, ecx
jnz @done

mov eax, [ebx+edi]
mov ecx, [ebx+edx]

@byte1: cmp ah, ch
je @byte2

and eax, $FF00
and ecx, $FF00
sub eax, 'a'*256
sub ecx, 'a'*256
cmp ah, 'z'-'a'
ja @up1a
sub eax, ('a'-'A')*256
@up1a: cmp ch, 'z'-'a'
ja @up1c
sub ecx, ('a'-'A')*256
@up1c: sub eax, ecx
jnz @done

mov eax, [ebx+edi]
mov ecx, [ebx+edx]

@byte2: add ebx, 2
jnl @len2
shr eax, 16
shr ecx, 16
cmp al, cl
je @byte3

and eax, $FF
and ecx, $FF
sub eax, 'a'
sub ecx, 'a'
cmp al, 'z'-'a'
ja @up2a
sub eax, 'a'-'A'
@up2a: cmp cl, 'z'-'a'
ja @up2c
sub ecx, 'a'-'A'
@up2c: sub eax, ecx
jnz @done

movzx eax, word ptr [ebx+edi]
movzx ecx, word ptr [ebx+edx]

@byte3: cmp ah, ch
je @byte4

and eax, $FF00
and ecx, $FF00
sub eax, 'a'*256
sub ecx, 'a'*256
cmp ah, 'z'-'a'
ja @up3a
sub eax, ('a'-'A')*256
@up3a: cmp ch, 'z'-'a'
ja @up3c
sub ecx, ('a'-'A')*256
@up3c: sub eax, ecx
jnz @done

@byte4: add ebx, 2
jl @loop2
@len2: pop eax
pop ebx
pop edi
ret

@done: pop ecx
pop ebx
pop edi
end;

//Author Aleksandr Sharahov
//Original name PosShaAsm5_a
//Instructionset(s): IA32

function Pos(const SubStr: AnsiString; const Str: AnsiString): Integer;
asm
push ebx
push esi
add esp, -16
test edx, edx
jz @NotFound
test eax, eax
jz @NotFound
mov esi, [edx-4] //Length(Str)
mov ebx, [eax-4] //Length(Substr)
cmp esi, ebx
jl @NotFound
test ebx, ebx
jle @NotFound
dec ebx
add esi, edx
add edx, ebx
mov [esp+8], esi
add eax, ebx
mov [esp+4], edx
neg ebx
movzx ecx, byte ptr [eax]
mov [esp], ebx
jnz @FindString

sub esi, 2
mov [esp+12], esi

@FindChar2:
cmp cl, [edx]
jz @Matched0ch
cmp cl, [edx+1]
jz @Matched1ch
add edx, 2
cmp edx, [esp+12]
jb @FindChar4
cmp edx, [esp+8]
jb @FindChar2
@NotFound:
xor eax, eax
jmp @Exit0ch

@FindChar4:
cmp cl, [edx]
jz @Matched0ch
cmp cl, [edx+1]
jz @Matched1ch
cmp cl, [edx+2]
jz @Matched2ch
cmp cl, [edx+3]
jz @Matched3ch
add edx, 4
cmp edx, [esp+12]
jb @FindChar4
cmp edx, [esp+8]
jb @FindChar2
xor eax, eax
jmp @Exit0ch

@Matched2ch:
add edx, 2
@Matched0ch:
inc edx
mov eax, edx
sub eax, [esp+4]
@Exit0ch:
add esp, 16
pop esi
pop ebx
ret

@Matched3ch:
add edx, 2
@Matched1ch:
add edx, 2
xor eax, eax
cmp edx, [esp+8]
ja @Exit1ch
mov eax, edx
sub eax, [esp+4]
@Exit1ch:
add esp, 16
pop esi
pop ebx
ret

@FindString4:
cmp cl, [edx]
jz @Test0
cmp cl, [edx+1]
jz @Test1
cmp cl, [edx+2]
jz @Test2
cmp cl, [edx+3]
jz @Test3
add edx, 4
cmp edx, [esp+12]
jb @FindString4
cmp edx, [esp+8]
jb @FindString2
xor eax, eax
jmp @Exit1

@FindString:
sub esi, 2
mov [esp+12], esi
@FindString2:
cmp cl, [edx]
jz @Test0
@AfterTest0:
cmp cl, [edx+1]
jz @Test1
@AfterTest1:
add edx, 2
cmp edx, [esp+12]
jb @FindString4
cmp edx, [esp+8]
jb @FindString2
xor eax, eax
jmp @Exit1

@Test3:
add edx, 2
@Test1:
mov esi, [esp]
@Loop1:
movzx ebx, word ptr [esi+eax]
cmp bx, word ptr [esi+edx+1]
jnz @AfterTest1
add esi, 2
jl @Loop1
add edx, 2
xor eax, eax
cmp edx, [esp+8]
ja @Exit1
@RetCode1:
mov eax, edx
sub eax, [esp+4]
@Exit1:
add esp, 16
pop esi
pop ebx
ret

@Test2:
add edx,2
@Test0:
mov esi, [esp]
@Loop0:
movzx ebx, word ptr [esi+eax]
cmp bx, word ptr [esi+edx]
jnz @AfterTest0
add esi, 2
jl @Loop0
inc edx
@RetCode0:
mov eax, edx
sub eax, [esp+4]
add esp, 16
pop esi
pop ebx
end;

//Author Aleksandr Sharahov
//Original name LowerCaseShaAsm6
//Instructionset(s): IA32

function LowerCase(const s: string): string;
asm
push ebx
push esi
push edi
mov esi, eax // s
mov eax, edx
test esi, esi
jz @Nil
mov edx, [esi-4] // Length(s)
mov edi, eax // @Result
test edx, edx
jle @Nil
mov ecx, [eax]
mov ebx, edx
test ecx, ecx
jz @Realloc // Jump if Result not allocated
test edx, 3
jnz @Length3
xor edx, [ecx-4]
cmp edx, 3
jbe @TestRef
jmp @Realloc
@Length3:
or edx, 2
xor edx, [ecx-4]
cmp edx, 1
ja @Realloc
@TestRef:
cmp [ecx-8], 1
je @LengthOK // Jump if Result RefCt=1
@Realloc:
mov edx, ebx
or edx, 3
call System.@LStrSetLength
@LengthOK:
mov edi, [edi] // Result
mov [edi-4], ebx // Correct Result length
mov byte ptr [ebx+edi], 0
add ebx, -1
and ebx, -4
mov eax, [ebx+esi]

@Loop: mov ecx, eax
or eax, $80808080 // $C1..$DA
mov edx, eax
sub eax, $5B5B5B5B // $66..$7F
xor edx, ecx // $80
or eax, $80808080 // $E6..$FF
sub eax, $66666666 // $80..$99
and eax, edx // $80
shr eax, 2 // $20
xor eax, ecx // Lower
mov [ebx+edi], eax
mov eax, [ebx+esi-4]
sub ebx, 4
jge @Loop

pop edi
pop esi
pop ebx
ret

@Nil: pop edi
pop esi
pop ebx
jmp System.@LStrClr // Result:=''
end;

//Author Aleksandr Sharahov
//Original name StrCompSha7
//Instructionset(s): IA32

function StrComp(const Str1, Str2: PChar): Integer;
asm
sub eax, edx
jz @ret
@loop:
movzx ecx, [eax+edx]
cmp cl, [edx]
jne @stop
test cl, cl
jz @eq
movzx ecx, [eax+edx+1]
cmp cl, [edx+1]
jne @stop1
test cl, cl
jz @eq
movzx ecx, [eax+edx+2]
cmp cl, [edx+2]
jne @stop2
test cl, cl
jz @eq
movzx ecx, [eax+edx+3]
cmp cl, [edx+3]
jne @stop3
add edx, 4
test cl, cl
jz @eq
movzx ecx, [eax+edx]
cmp cl, [edx]
jne @stop
test cl, cl
jz @eq
movzx ecx, [eax+edx+1]
cmp cl, [edx+1]
jne @stop1
test cl, cl
jz @eq
movzx ecx, [eax+edx+2]
cmp cl, [edx+2]
jne @stop2
test cl, cl
jz @eq
movzx ecx, [eax+edx+3]
cmp cl, [edx+3]
jne @stop3
add edx, 4
test cl, cl
jnz @loop
@eq:
xor eax, eax
@ret:
ret
@stop3:
add edx, 1
@stop2:
add edx, 1
@stop1:
add edx, 1
@stop:
mov eax, ecx
movzx edx, [edx]
sub eax, edx
end;

//Author Aleksandr Sharahov
//Original name StrCopyShaAsm3
//Instructionset(s): IA32

function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
sub edx,eax;
test eax, 1;
push eax;
jz @loop;
movzx ecx,byte ptr[eax+edx+00]; test cl, cl; mov [eax+00],cl; jz @ret;
add eax, 1;
@loop:
movzx ecx,byte ptr[eax+edx+00]; test cl, cl; jz @ret00;
movzx ecx,word ptr[eax+edx+00]; cmp ecx,255; mov [eax+00],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+02]; test cl, cl; jz @ret02;
movzx ecx,word ptr[eax+edx+02]; cmp ecx,255; mov [eax+02],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+04]; test cl, cl; jz @ret04;
movzx ecx,word ptr[eax+edx+04]; cmp ecx,255; mov [eax+04],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+06]; test cl, cl; jz @ret06;
movzx ecx,word ptr[eax+edx+06]; cmp ecx,255; mov [eax+06],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+08]; test cl, cl; jz @ret08;
movzx ecx,word ptr[eax+edx+08]; cmp ecx,255; mov [eax+08],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+10]; test cl, cl; jz @ret10;
movzx ecx,word ptr[eax+edx+10]; cmp ecx,255; mov [eax+10],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+12]; test cl, cl; jz @ret12;
movzx ecx,word ptr[eax+edx+12]; cmp ecx,255; mov [eax+12],cx; jbe @ret;
movzx ecx,byte ptr[eax+edx+14]; test cl, cl; jz @ret14;
movzx ecx,word ptr[eax+edx+14]; mov [eax+14],cx;
add eax,16;
cmp ecx,255; ja @loop;
@ret:
pop eax; ret;
@ret00:
mov [eax+00],cl; pop eax; ret;
@ret02:
mov [eax+02],cl; pop eax; ret;
@ret04:
mov [eax+04],cl; pop eax; ret;
@ret06:
mov [eax+06],cl; pop eax; ret;
@ret08:
mov [eax+08],cl; pop eax; ret;
@ret10:
mov [eax+10],cl; pop eax; ret;
@ret12:
mov [eax+12],cl; pop eax; ret;
@ret14:
mov [eax+14],cl; pop eax; //ret;
end;

//Author John O'Harrow
//Original name UpperCaseJOH_MMX
//Instructionset(s): IA32, MMX

var
UppercaseLookUp : array[Char] of Char;

procedure InitializeLookUpTable;
var
C : Char;
begin
for C := #0 to #255 do
UppercaseLookUp[C] := UpCase(C);
end;

function UpperCase(const S: string): string;
const
B05 : Int64 = $0505050505050505;
B65 : Int64 = $6565656565656565;
B20 : Int64 = $2020202020202020;
asm
xchg eax, edx
test edx, edx {Test for S = ''}
jz system.@LStrSetLength {Return Empty String}
mov ecx, edx {Addr(S)}
mov edx, [edx-4]
test edx, edx
jle system.@LStrSetLength {Return Empty String}
push ebx
push ecx {Addr(S)}
push edx {Length}
mov ebx, eax {Addr(Result)}
call system.@LStrSetLength {Create Result String}
pop ecx {Length}
pop eax {Addr(S)}
mov edx, [ebx] {Result}
cmp ecx, 16 {Use Table if Length < 16}
jl @@Small
movq mm4, B05
movq mm5, B65
movq mm6, B20
add eax, ecx
add edx, ecx
neg ecx
@@LargeLoop:
movq mm0, [eax+ecx ]
movq mm1, [eax+ecx+8]
movq mm2, mm0
movq mm3, mm1
paddb mm2, mm4
paddb mm3, mm4
pcmpgtb mm2, mm5
pcmpgtb mm3, mm5
pand mm2, mm6
pand mm3, mm6
psubb mm0, mm2
psubb mm1, mm3
movq [edx+ecx ], mm0
movq [edx+ecx+8], mm1
add ecx, 16
and ecx, -16 {Prevent Read Past Last Character}
jnz @@LargeLoop {Loop until all Characters Done}
pop ebx
emms
ret
@@Small:
push ebp
lea ebp, UppercaseLookUp
@@SmallLoop:
sub ecx, 1
movzx ebx, [eax+ecx]
movzx ebx, [ebp+ebx]
mov [edx+ecx], bl
jg @@SmallLoop
pop ebp
pop ebx
end;

var
Ch : Char;

initialization

for Ch := #0 to #255 do
AnsiUpcase[Ch] := AnsiUpperCase(Ch)[1];

InitializeLookUpTable;

end.


.

Relevant Pages