Delphi：64位快速Pos函数

Question

是否有一种能够在64位系统中与当前32位版本同样快速的Pos()代码？

据我了解，Delphi的32位版本（测试过XE5）多年前采用了FastCode汇编版本，但64位版本使用的是PurePascal版本，速度大约慢了5到10倍。

进行一些测试，相同的过程在一个长循环中：

32位：65..90毫秒

64位：280..300毫秒

- hikari

---

请问您能提供您的测试程序吗？ - David Heffernan

你是在搜索子字符串还是单个字符？ - Arioch 'The

我搜索子字符串 - hikari

我关于纯Pascal中Pos方法的效率制作了一个QC报告。在Inefficient loop in Pos() for purepascal中可以找到更快的实现方法。结论是使用FastCoders纯Pascal版本的PosSHA或PosSHA2。您可以在Fastcoders网站上找到这些代码，网址为http://fastcode.sourceforge.net/。 - LU RD

嗨，我有FastCode文件，但找不到PosSHA/PosSHA2函数，请问你能指导我吗？谢谢。 - hikari

Answer 1

使用Fastcoders纯Pascal的PosEx_Sha_Pas_2算法（已修改以适应x64）：

function PosEx_Sha_Pas_2(const SubStr, S: string; Offset: Integer = 1): Integer;
Type
  PInteger =^Integer;
var
  len, lenSub: Integer;
  ch: char;
  p, pSub, pStart, pStop: pchar;
label
  Loop0, Loop4,
  TestT, Test0, Test1, Test2, Test3, Test4,
  AfterTestT, AfterTest0,
  Ret, Exit;
begin;
  pSub := pointer(SubStr);
  p := pointer(S);

  if (p = nil) or (pSub = nil) or (Offset < 1) then
  begin;
    Result := 0;
    goto Exit;
  end;

  lenSub := PLongInt(PByte(pSub) - 4)^ - 1; // <- Modified
  len := PLongInt(PByte(p) - 4)^; // <- Modified
  if (len < lenSub + Offset) or (lenSub < 0) then
  begin;
    Result := 0;
    goto Exit;
  end;

  pStop := p + len;
  p := p + lenSub;
  pSub := pSub + lenSub;
  pStart := p;
  p := p + Offset + 3;

  ch := pSub[0];
  lenSub := -lenSub;
  if p < pStop then
    goto Loop4;
  p := p - 4;
  goto Loop0;

Loop4:
  if ch = p[-4] then
    goto Test4;
  if ch = p[-3] then
    goto Test3;
  if ch = p[-2] then
    goto Test2;
  if ch = p[-1] then
    goto Test1;
Loop0:
  if ch = p[0] then
    goto Test0;
AfterTest0:
  if ch = p[1] then
    goto TestT;
AfterTestT:
  p := p + 6;
  if p < pStop then
    goto Loop4;
  p := p - 4;
  if p < pStop then
    goto Loop0;
  Result := 0;
  goto Exit;

Test3:
  p := p - 2;
Test1:
  p := p - 2;
TestT:
  len := lenSub;
  if lenSub <> 0 then
    repeat
      ;
      if (pSub[len] <> p[len + 1]) or (pSub[len + 1] <> p[len + 2]) then
        goto AfterTestT;
      len := len + 2;
    until len >= 0;
  p := p + 2;
  if p <= pStop then
    goto Ret;
  Result := 0;
  goto Exit;

Test4:
  p := p - 2;
Test2:
  p := p - 2;
Test0:
  len := lenSub;
  if lenSub <> 0 then
    repeat
      ;
      if (pSub[len] <> p[len]) or (pSub[len + 1] <> p[len + 1]) then
        goto AfterTest0;
      len := len + 2;
    until len >= 0;
  Inc(p);
Ret:
  Result := p - pStart;
Exit:
end;

使用David的测试用例（x64版本发布）得出的结果：

System.Pos       18427
wcsstr            8122
PosEx_Sha_Pas_2   2282

对于x32版本，结果如下：

System.Pos        2171
wcsstr            9634
PosEx_Sha_Pas_2   1868

---

结论：

PosEx_Sha_Pas_2在x64位模式下的速度几乎与x32位模式下的Pos相同。 此外，PosEx_Sha_Pas_2在x32位模式下似乎比Pos更快。

这里所有的测试都是使用XE4版本进行的。

---

改进purepascal System.Pos()仍然在Tokyo 10.2中保持开放状态。

---

更新：

从Delphi 11.0 Alexandria开始，Pos()的纯Pascal版本将使用Fastcoders的PosEx_Sha_Pas_2.pas版本。感谢@StefanGlienke为此付出的努力！

- LU RD

---

非常好。将此应用于自定义的XML解析器后，速度在x64上提高了10倍。谢谢！ - hikari

我怀疑在我们能够说SHA版本比x86 asm Pos更好之前，我们需要进行更全面的测试。也许子字符串长度很重要。 - David Heffernan

@DavidHeffernan，我对32位模式进行了更多测试，似乎如果在前20-25个字符中找到子字符串，则System.Pos会稍微快一些。之后，SHA版本更有效。子字符串的大小实际上没有任何影响。 - LU RD

与纯汇编32位版本（Tokyo 10.2/W10）相比，这仍然非常慢。 - hikari

@hikari，为了提高AnsiStrings的64位性能，请使用上述函数。只需将“String”更改为“AnsiString”，“Char”更改为“AnsiChar”，“PChar”更改为“PAnsiChar”。与纯Pascal PosEx_Sha_Pas_2例程相比，AnsiStrings的速度提高了约50％ :-) - LU RD

Answer 2

在64位代码中，系统提供的msvcrt.dll实现的C运行时函数wcsstr比Delphi RTL Pos更好。

{$APPTYPE CONSOLE}

uses
  SysUtils, Diagnostics;

function wcsstr(const str, strsearch: PWideChar): PWideChar; cdecl; external 'msvcrt.dll';

var
  i, j: Integer;
  Stopwatch: TStopwatch;
  str: string;
  P: PWideChar;

const
  N = 50000000;

begin
  str := 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do '
    + 'eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim '
    + 'ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut '
    + 'aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit '
    + 'in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur '
    + 'sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt '
    + 'mollit anim id est laborum.';

  Stopwatch := TStopwatch.StartNew;
  for i := 1 to N do
  begin
    j := Pos('tempor', str);
    if j=0 then
      Beep;
  end;
  Writeln('Pos: ' + IntToStr(Stopwatch.ElapsedMilliseconds));

  Stopwatch := TStopwatch.StartNew;
  for i := 1 to N do
  begin
    P := wcsstr(PChar(str), 'tempor');
    if P=nil then
      Beep;
  end;
  Writeln('wcsstr: ' + IntToStr(Stopwatch.ElapsedMilliseconds));

  Readln;
end.

32位发行版本

Pos：1930
wcsstr：6951

64位发行版本

Pos：18384
wcsstr：6701

有趣的是，32位的Pos显然被很好地实现了。

我的系统在i5-2300上运行Win7 x64。

- David Heffernan

---

我的测试结果（平均值）：32位：pos=630，wcsstr=1330；64位：pos=2730，wcsstr=1300。 - hikari

看起来FastCoders的纯Pascal算法比wcsstr更好。 - LU RD