paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 23:01:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improve shortstring Pos() and generic fpc_shortstr_compare().

Browse Source
This commit is contained in:
Rika Ichinose 2023-04-24 04:32:07 +03:00 committed by FPK
parent dd1565c667
commit fca0ace070
2 changed files with 18 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/inc/generic.inc
View File

@ -951,8 +951,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE} {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
function fpc_shortstr_compare(const left,right:shortstring) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc; function fpc_shortstr_compare(const left,right:shortstring) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
var var
s1,s2,max,i : byte; s1,s2,max : byte;
d : ObjpasInt;
begin begin
s1:=length(left); s1:=length(left);
s2:=length(right); s2:=length(right);
@ -960,20 +959,10 @@ begin
max:=s1 max:=s1
else else
max:=s2; max:=s2;
for i:=1 to max do result:=CompareByte(left[1],right[1],max);
begin if result=0 then
d:=byte(left[i])-byte(right[i]); result:=s1-s2;
if d>0 then result:=ord(result>0)-ord(result<0);
exit(1)
else if d<0 then
exit(-1);
end;
if s1>s2 then
exit(1)
else if s1<s2 then
exit(-1)
else
exit(0);
end; end;
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE} {$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}

37
rtl/inc/sstrings.inc
View File

@ -127,25 +127,21 @@ end;
{$define FPC_HAS_SHORTSTR_POS_SHORTSTR} {$define FPC_HAS_SHORTSTR_POS_SHORTSTR}
function pos(const substr : shortstring;const s : shortstring; Offset : Sizeint = 1):SizeInt; function pos(const substr : shortstring;const s : shortstring; Offset : Sizeint = 1):SizeInt;
var var
i,MaxLen : SizeInt; i,MaxLen,d : SizeInt;
pc : PAnsiChar;
begin begin
Pos:=0; Pos:=0;
if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(S)) then if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(S)) then
begin begin
MaxLen:=sizeint(Length(s))-Length(SubStr); MaxLen:=sizeint(Length(s))-Length(SubStr)+1;
i:=Offset-1; i:=Offset;
pc:=@s[Offset];
while (i<=MaxLen) do while (i<=MaxLen) do
begin begin
inc(i); d:=IndexByte(s[i],MaxLen-i+1,byte(substr[1]));
if (SubStr[1]=pc^) and if d<0 then
(CompareChar(Substr[1],pc^,Length(SubStr))=0) then
begin
Pos:=i;
exit; exit;
end; if (CompareByte(Substr[1],s[i+d],Length(SubStr))=0) then
inc(pc); exit(i+d);
i:=i+d+1;
end; end;
end; end;
end; end;
@ -157,23 +153,14 @@ end;
{Faster when looking for a single AnsiChar...} {Faster when looking for a single AnsiChar...}
function pos(c:ansichar;const s:shortstring; Offset : Sizeint = 1 ):SizeInt; function pos(c:ansichar;const s:shortstring; Offset : Sizeint = 1 ):SizeInt;
var var
i : SizeInt; idx : SizeInt;
pc : PAnsiChar;
begin begin
Pos:=0; Pos:=0;
if (Offset<1) or (Offset>Length(S)) then if (Offset<1) or (Offset>Length(S)) then
exit; exit;
pc:=@s[Offset]; idx:=IndexByte(s[Offset],length(s)-Offset+1,byte(c));
for i:=Offset to length(s) do if idx>=0 then
begin Pos:=Offset+idx;
if pc^=c then
begin
pos:=i;
exit;
end;
inc(pc);
end;
pos:=0;
end; end;
{$endif FPC_HAS_SHORTSTR_POS_CHAR} {$endif FPC_HAS_SHORTSTR_POS_CHAR}