Delphi 10.2 for Win64发布目标下的FillChar和StringOfChar

Question

我有一个关于Delphi 10.2 Pascal编程语言中特定编程问题的疑问。

在发布到Win64的CPU上（在2012年之前发布）时，StringOfChar和FillChar函数不能正常工作。

• FillChar的期望结果是在给定的内存缓冲区中只有重复的8位字符序列。

• StringOfChar的期望结果相同，但结果存储在字符串类型中。

但实际情况是，当我将之前在Delphi 10.2之前版本中工作的应用程序编译成10.2版本的Delphi时，我们为Win64编译的应用程序在2012年之前发布的CPU上无法正常工作。

StringOfChar和FillChar函数不能正常工作 - 它们返回不同字符的字符串，尽管这些字符以重复模式出现 - 而不是像预期的那样只有相同字符的序列。

以下是最小代码，足以说明此问题。请注意，序列的长度应至少为16个字符，且字符不应为nul（＃0）。代码如下：

procedure TestStringOfChar;
var
  a: AnsiString;
  ac: AnsiChar;
begin
  ac := #1;
  a := StringOfChar(ac, 43);
  if a <> #1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1#1 then
  begin
    raise Exception.Create('ANSI StringOfChar Failed!!');
  end;
end;

我知道在StackOverflow上有很多Delphi程序员。你是否遇到了同样的问题？如果是，你是如何解决的？顺便说一下，我已经联系了Delphi开发者，但他们至今没有确认或否认这个问题。我正在使用Embarcadero Delphi 10.2版本25.0.26309.314。

更新:

如果你的CPU是2012年或之后制造的，请在调用StringOfChar之前加入以下行以重现此问题：

const
  ERMSBBit    = 1 shl 9; //$0200
begin
  CPUIDTable[7].EBX := CPUIDTable[7].EBX and not ERMSBBit;

关于2017年4月RAD Studio 10.2工具链问题热修复 - 我已经尝试过使用和不使用它 - 它没有帮助。该问题存在于是否安装了热修复之后。

更新＃2

Embarcadero已在2017年8月8日下午6:03确认并解决了这个问题。因此，在Delphi 10.2 Tokyo Release 1（发布于2017年8月8日）中，已经修复了此错误。

- Maxim Masiutin

---

这明显是RTL的错误，而不是编译器的错误。唯一要做的事情就是手动修补RTL，直到Embarcadero适当地解决它，或者避免使用受该错误影响的RTL部分。 - Remy Lebeau

你最近使用了发布的热修复吗？并且你已经提交了一个错误报告。我不确定你在这里的问题是什么。我们不是这个工具的开发者，无法修复它。 - David Heffernan

但问题是什么？这不是报告编译器错误的地方。 - David Heffernan

你的程序已经在运行时生成代码。这就是窗口过程与方法相连接的方式，也被称为thunk。你可以使用任何解决方案。个人而言，我更喜欢避免重新编译RTL单元。我认为那很脆弱且难以管理。钩子代码是主流且广泛使用的。 - David Heffernan

我注意到你自己写了一个关于ERMSB的长答案。我看到FillChar检查它，如果设置了它，就会执行一个简单的REP STOSB。为什么现在不直接设置这个位呢？有些填充可能会慢一些，但这有多大问题呢？ - Rudy Velthuis

Answer 1

StringOfChar(A: AnsiChar, count)使用FillChar实现。

你可以使用以下代码来解决问题：

(*******************************************************
 System.FastSystem
 A fast drop-in addition to speed up function in system.pas
 It should compile and run in XE2 and beyond.
 Alpha version 0.5, fully tested in Win64
 (c) Copyright 2016 J. Bontes
   This Source Code Form is subject to the terms of the
   Mozilla Public License, v. 2.0.
   If a copy of the MPL was not distributed with this file,
   You can obtain one at http://mozilla.org/MPL/2.0/.
********************************************************
FillChar code is an altered version FillCharsse2 SynCommons.pas
which is part of Synopse framework by Arnaud Bouchez
********************************************************
Changelog
0.5 Initial version:
********************************************************)

unit FastSystem;

interface

procedure FillChar(var Dest; Count: NativeInt; Value: ansichar); inline; overload;
procedure FillChar(var Dest; Count: NativeInt; Value: Byte); overload;
procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); inline;
{$EXTERNALSYM FillMemory}
procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); inline;
{$EXTERNALSYM ZeroMemory}

implementation

procedure FillChar(var Dest; Count: NativeInt; Value: ansichar); inline; overload;
begin
  FillChar(Dest, Count, byte(Value));
end;

procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte);
begin
  FillChar(Destination^, Length, Fill);
end;

procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); inline;
begin
  FillChar(Destination^, Length, 0);
end;

//This code is 3x faster than System.FillChar on x64.

{$ifdef CPUX64}
procedure FillChar(var Dest; Count: NativeInt; Value: Byte);
//rcx = dest
//rdx=count
//r8b=value
asm
              .noframe
              .align 16
              movzx r8,r8b           //There's no need to optimize for count <= 3
              mov rax,$0101010101010101
              mov r9d,edx
              imul rax,r8            //fill rax with value.
              cmp rdx,59             //Use simple code for small blocks.
              jl  @Below32
@Above32:     mov r11,rcx
              mov r8b,7              //code shrink to help alignment.
              lea r9,[rcx+rdx]       //r9=end of array
              sub rdx,8
              rep mov [rcx],rax
              add rcx,8
              and r11,r8             //and 7 See if dest is aligned
              jz @tail
@NotAligned:  xor rcx,r11            //align dest
              lea rdx,[rdx+r11]
@tail:        test r9,r8             //and 7 is tail aligned?
              jz @alignOK
@tailwrite:   mov [r9-8],rax         //no, we need to do a tail write
              and r9,r8              //and 7
              sub rdx,r9             //dec(count, tailcount)
@alignOK:     mov r10,rdx
              and edx,(32+16+8)      //count the partial iterations of the loop
              mov r8b,64             //code shrink to help alignment.
              mov r9,rdx
              jz @Initloop64
@partialloop: shr r9,1              //every instruction is 4 bytes
              lea r11,[rip + @partial +(4*7)] //start at the end of the loop
              sub r11,r9            //step back as needed
              add rcx,rdx            //add the partial loop count to dest
              cmp r10,r8             //do we need to do more loops?
              jmp r11                //do a partial loop
@Initloop64:  shr r10,6              //any work left?
              jz @done               //no, return
              mov rdx,r10
              shr r10,(19-6)         //use non-temporal move for > 512kb
              jnz @InitFillHuge
@Doloop64:    add rcx,r8
              dec edx
              mov [rcx-64+00H],rax
              mov [rcx-64+08H],rax
              mov [rcx-64+10H],rax
              mov [rcx-64+18H],rax
              mov [rcx-64+20H],rax
              mov [rcx-64+28H],rax
              mov [rcx-64+30H],rax
              mov [rcx-64+38H],rax
              jnz @DoLoop64
@done:        rep ret
              //db $66,$66,$0f,$1f,$44,$00,$00 //nop7
@partial:     mov [rcx-64+08H],rax
              mov [rcx-64+10H],rax
              mov [rcx-64+18H],rax
              mov [rcx-64+20H],rax
              mov [rcx-64+28H],rax
              mov [rcx-64+30H],rax
              mov [rcx-64+38H],rax
              jge @Initloop64        //are we done with all loops?
              rep ret
              db $0F,$1F,$40,$00
@InitFillHuge:
@FillHuge:    add rcx,r8
              dec rdx
              db $48,$0F,$C3,$41,$C0 // movnti  [rcx-64+00H],rax
              db $48,$0F,$C3,$41,$C8 // movnti  [rcx-64+08H],rax
              db $48,$0F,$C3,$41,$D0 // movnti  [rcx-64+10H],rax
              db $48,$0F,$C3,$41,$D8 // movnti  [rcx-64+18H],rax
              db $48,$0F,$C3,$41,$E0 // movnti  [rcx-64+20H],rax
              db $48,$0F,$C3,$41,$E8 // movnti  [rcx-64+28H],rax
              db $48,$0F,$C3,$41,$F0 // movnti  [rcx-64+30H],rax
              db $48,$0F,$C3,$41,$F8 // movnti  [rcx-64+38H],rax
              jnz @FillHuge
@donefillhuge:mfence
              rep ret
              db $0F,$1F,$44,$00,$00  //db $0F,$1F,$40,$00
@Below32:     and  r9d,not(3)
              jz @SizeIs3
@FillTail:    sub   edx,4
              lea   r10,[rip + @SmallFill + (15*4)]
              sub   r10,r9
              jmp   r10
@SmallFill:   rep mov [rcx+56], eax
              rep mov [rcx+52], eax
              rep mov [rcx+48], eax
              rep mov [rcx+44], eax
              rep mov [rcx+40], eax
              rep mov [rcx+36], eax
              rep mov [rcx+32], eax
              rep mov [rcx+28], eax
              rep mov [rcx+24], eax
              rep mov [rcx+20], eax
              rep mov [rcx+16], eax
              rep mov [rcx+12], eax
              rep mov [rcx+08], eax
              rep mov [rcx+04], eax
              mov [rcx],eax
@Fallthough:  mov [rcx+rdx],eax  //unaligned write to fix up tail
              rep ret

@SizeIs3:     shl edx,2           //r9 <= 3  r9*4
              lea r10,[rip + @do3 + (4*3)]
              sub r10,rdx
              jmp r10
@do3:         rep mov [rcx+2],al
@do2:         mov [rcx],ax
              ret
@do1:         mov [rcx],al
              rep ret
@do0:         rep ret
end;
{$endif}

解决您的问题最简单的方法是下载Mormot，并将SynCommon.pas包含到您的项目中。这将修补System.FillChar到上述代码，并包括一些其他性能提升。

请注意，您不需要所有的Mormot，只需要SynCommons即可。

- Johan

---

这在柏林和以下地区可能会快3倍，但东京得到了优化更新。对我来说它有效，但显然对Maxim不起作用。我可以计时两者，看哪个对我更快。等一下... - Rudy Velthuis

好的，我检查了。这比新的System.FillChar更快。大约快2-3倍。 - Rudy Velthuis

再次感谢Johan为SynCommons.pas贡献了他的x64汇编代码！ - Arnaud Bouchez

在我的系统中，使用16K缓冲区和Delphi 10.2.3 x64-Release构建的System.FillChar比这个自定义版本快2倍。确切地说是快2倍。当缓冲区大小增加时，差异会稍微小一些，但仍然更快。此外，我根本无法重现错误。 - Alexandre M

Answer 2

我从FastCode挑战中取得了测试用例 - http://fastcode.sourceforge.net/ 我已经在Win64下编译了FillChar测试工具，并删除了测试中所有32位版本的FillChar。

我保留了2个64位FillChar版本：

1. FC_TokyoBugfixAVXEx - 在Delphi Tokyo 64位中出现，修复了错误并添加了AVX寄存器。每次调用FillChar时都会检测ERMSB、AVX1和AVX2 CPU功能。这种分支发生在每个FillChar调用上。没有入口点修补或函数地址映射。

2. FillChar_J_Bontes - 另一个版本的FillChar，即您在此处发布的System.FastSystem中的函数。

我没有测试Delphi Tokyo中的vanilla FillChar，因为它包含我最初发布的错误描述，并且未正确处理ERMSB。

Kaby Lake - i7-7700K

第一列是函数的对齐方式。 接下来的4列是各种测试的结果，较低的数字更好。总共有4个测试。第一个测试使用较小的块，第二个测试使用较大的块，依此类推。 最后一列是所有测试的加权摘要。

第一个测试中的CPU是Kaby Lake i7-7700K（2017年1月）。频率4.2 GHz（Turbo频率高达4.5 GHz），L2缓存4×256 KB，L3缓存8 MB。

Ivy Bridge - E5-2603 v2

以下是第二次测试的结果，使用了先前的微架构：Xeon E5-2603 v2“Ivy Bridge”（2013年9月），频率1.8 GHz，L2缓存4×256 KB，L3缓存10 MB，RAM 4×DDR3-1333。

Ivy Bridge - E5-2643 v2

以下是第三组硬件的测试结果：Intel Xeon E5-2643 v2（2013年9月），频率3.5 GHz，L2缓存6×256 KB，L3缓存25 MB，RAM 4×DDR3-1600。

英特尔酷睿 i9 7900X

这里是第四个测试硬件的测试结果：英特尔酷睿 i9 7900X（2017年6月），频率为3.3 GHz（可加速至4.5 GHz），L2缓存10×1024 KB，L3缓存13.75 MB，RAM 4 × DDR4-2134。

- Maxim Masiutin