paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 15:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Rika: optimize Pos(), resolves #40088

Browse Source
This commit is contained in:
florian 2023-01-23 22:51:40 +01:00
parent 821c22a38f
commit 84e7a17b67
2 changed files with 60 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
rtl/inc/astrings.inc
View File

@ -948,27 +948,24 @@ end;
{$ifndef FPC_HAS_POS_SHORTSTR_ANSISTR}
{$define FPC_HAS_POS_SHORTSTR_ANSISTR}
Function Pos(Const Substr : ShortString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
var
i,MaxLen : SizeInt;
pc : PAnsiChar;
i,MaxLen,nsource,nsub,d : SizeInt;
begin
Pos:=0;
if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
nsource:=Length(Source);
nsub:=Length(Substr);
if (nsub>0) and (Offset>0) and (Offset<=nsource) then
begin
MaxLen:=Length(source)-Length(SubStr);
i:=Offset-1;
pc:=@source[Offset];
MaxLen:=nsource-nsub+1;
i:=Offset;
while (i<=MaxLen) do
begin
inc(i);
if (SubStr[1]=pc^) and
(CompareByte(Substr[1],pc^,Length(SubStr))=0) then
begin
Pos:=i;
exit;
end;
inc(pc);
d:=IndexByte(Source[i],MaxLen-i+1,byte(Substr[1]));
if d<0 then
exit;
if CompareByte(Substr[1],Source[i+d],nsub)=0 then
exit(i+d);
i:=i+d+1;
end;
end;
end;
@ -979,25 +976,23 @@ end;
{$define FPC_HAS_POS_ANSISTR_ANSISTR}
Function Pos(Const Substr : RawByteString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
var
i,MaxLen : SizeInt;
pc : PAnsiChar;
i,MaxLen,nsource,nsub,d : SizeInt;
begin
Pos:=0;
if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
nsource:=Length(Source);
nsub:=Length(Substr);
if (nsub>0) and (Offset>0) and (Offset<=nsource) then
begin
MaxLen:=Length(source)-Length(SubStr);
i:=Offset-1;
pc:=@source[Offset];
MaxLen:=nsource-nsub+1;
i:=Offset;
while (i<=MaxLen) do
begin
inc(i);
if (SubStr[1]=pc^) and
(CompareByte(Substr[1],pc^,Length(SubStr))=0) then
begin
Pos:=i;
exit;
end;
inc(pc);
d:=IndexByte(Source[i],MaxLen-i+1,byte(Substr[1]));
if d<0 then
exit;
if CompareByte(Substr[1],Source[i+d],nsub)=0 then
exit(i+d);
i:=i+d+1;
end;
end;
end;
@ -1012,23 +1007,16 @@ end;
{ (exact match for first argument), also with $h+ (JM) }
Function Pos(c : AnsiChar; Const s : RawByteString; Offset : Sizeint = 1) : SizeInt;
var
i: SizeInt;
pc : PAnsiChar;
ns,idx: SizeInt;
begin
Pos:=0;
If (Offset<1) or (Offset>Length(S)) then
exit;
pc:=@s[OffSet];
for i:=Offset to length(s) do
begin
if pc^=c then
begin
pos:=i;
exit;
end;
inc(pc);
end;
pos:=0;
ns:=length(s);
if (Offset>0) and (Offset<=ns) then
begin
idx:=IndexByte(s[Offset],ns-Offset+1,byte(c));
if idx>=0 then
pos:=Offset+idx;
end;
end;
{$endif FPC_HAS_POS_ANSICHAR_ANSISTR}

74
rtl/inc/ustrings.inc
View File

@ -1187,25 +1187,23 @@ end;
{$define FPC_HAS_POS_UNICODESTR_UNICODESTR}
Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
var
i,MaxLen : SizeInt;
pc : punicodechar;
i,MaxLen,nsource,nsub,d : SizeInt;
begin
Pos:=0;
if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
nsource:=Length(Source);
nsub:=Length(Substr);
if (nsub>0) and (Offset>0) and (Offset<=nsource) then
begin
MaxLen:=Length(source)-Length(SubStr)-(OffSet-1);
i:=0;
pc:=@source[OffSet];
MaxLen:=nsource-nsub+1;
i:=Offset;
while (i<=MaxLen) do
begin
inc(i);
if (SubStr[1]=pc^) and
(CompareWord(Substr[1],pc^,Length(SubStr))=0) then
begin
Pos:=Offset+i-1;
exit;
end;
inc(pc);
d:=IndexWord(Source[i],MaxLen-i+1,word(Substr[1]));
if d<0 then
exit;
if CompareWord(Substr[1],Source[i+d],nsub)=0 then
exit(i+d);
i:=i+d+1;
end;
end;
end;
@ -1217,23 +1215,16 @@ end;
{ Faster version for a unicodechar alone }
Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
var
i: SizeInt;
pc : punicodechar;
ns,idx: SizeInt;
begin
if (Offset>0) and (Offset<=length(s)) then
begin
pc:=@s[OffSet];
for i:=OffSet to length(s) do
begin
if pc^=c then
begin
pos:=i;
exit;
end;
inc(pc);
end;
end;
pos:=0;
ns:=length(s);
if (Offset>0) and (Offset<=ns) then
begin
idx:=IndexWord(s[Offset],ns-Offset+1,word(c));
if idx>=0 then
pos:=Offset+idx;
end;
end;
{$endif FPC_HAS_POS_UNICODECHAR_UNICODESTR}
@ -1274,25 +1265,16 @@ end;
{ (exact match for first argument), also with $h+ (JM) }
Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
var
i: SizeInt;
wc : unicodechar;
pc : punicodechar;
ns,idx: SizeInt;
begin
if (Offset>0) and (Offset<=Length(S)) then
begin
wc:=c;
pc:=@s[OffSet];
for i:=OffSet to length(s) do
begin
if pc^=wc then
begin
pos:=i;
exit;
end;
inc(pc);
end;
end;
pos:=0;
ns:=length(s);
if (Offset>0) and (Offset<=ns) then
begin
idx:=IndexWord(s[Offset],ns-Offset+1,word(unicodechar(c)));
if idx>=0 then
pos:=Offset+idx;
end;
end;
{$endif FPC_HAS_POS_CHAR_UNICODESTR}