Multithreading 并行处理字符串Delphi完全可用CPU使用率

目标是在单个Delphi应用程序中将浮点转换为字符串时，充分利用可用的内核。我认为这个问题适用于字符串的一般处理。但在我的示例中，我具体使用了FloatToStr方法

我在做什么（我一直保持这一点非常简单，因此在实现方面几乎没有歧义）：

• 使用delphixe6
• 创建从TThread继承的线程对象，并启动它们
• 在线程执行过程中，它将转换大量 通过FloatToStr方法加倍为字符串
• 简单地说，这些双精度是相同的常数，因此没有 线程所需的共享或全局内存资源

虽然使用了多个内核，但CPU使用率%始终将在单个内核的数量上达到最大值。我知道这是一个既定的问题。所以我有一些具体的问题

通过一种简单的方式，相同的操作可以由多个应用程序实例来完成，从而更充分地利用可用的CPU。是否可以在同一个可执行文件中有效地执行此操作？ 即，在操作系统级别或操作系统认可的某个等效分区上为线程分配不同的进程ID？或者这在开箱即用的Delphi中根本不可能实现

关于范围： 我知道有不同的内存管理器可用&其他组已经尝试更改一些较低级别的asm锁使用情况 但是，我问这个问题的范围是不在这么低的水平上做事

谢谢

---

嗨，J.我的代码非常简单：

TTaskThread = class(TThread)
public
  procedure Execute; override;
end;

procedure TTaskThread.Execute;
var
  i: integer;
begin
  Self.FreeOnTerminate := True;
  for i := 0 to 1000000000 do
    FloatToStr(i*1.31234);
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
  t1, t2, t3: TTaskThread;
begin
  t1 := TTaskThread.Create(True);
  t2 := TTaskThread.Create(True);
  t3 := TTaskThread.Create(True);
  t1.Start;
  t2.Start;
  t3.Start;
end;

这是一个“测试代码”，其中CPU（通过性能监视器）的最大值为25%（我有4个内核）。如果将FloatToStr行交换为非字符串操作，例如电源（i，2），则性能监视器显示预期的75%使用率。 （是的，有更好的方法来衡量这一点，但我认为就这一问题的范围而言，这已经足够了）

我已经相当彻底地探讨了这个问题。问题的目的是以非常简单的形式提出问题的症结所在

我在询问使用FloatToStr方法时的限制。并询问是否有一个实现化身，它将允许更好地使用可用的核心

---

谢谢。

我赞同其他人在评论中所说的话。FastMM内存管理器是不可伸缩的，这是Delphi肮脏的小秘密之一

因为内存管理器可以被替换，所以您可以简单地用可伸缩内存管理器替换FastMM。这是一个迅速变化的领域。每隔几个月就会出现新的可伸缩内存管理器。问题是很难编写正确的可伸缩内存管理器。你准备相信什么？有一件事可以对FastMM有利，那就是它很健壮

与其更换内存管理器，不如更换需要更换的内存管理器。简单地避免堆分配。找到一种方法来处理重复调用以分配动态内存的需求。即使您有一个可伸缩的堆管理器，堆分配仍然需要成本

---

一旦决定避免堆分配，下一个决定是使用什么来代替

FloatToStr

。根据我的经验，Delphi运行库并没有提供太多支持。例如，我最近发现，使用调用方提供的缓冲区将整数转换为文本没有好方法。因此，您可能需要使用自己的转换函数。作为证明这一点的简单第一步，请尝试从

msvcrt.dll

调用

sprintf

。这将提供概念证明

如果您无法更改内存管理器（MM），唯一要做的就是避免在MM可能成为瓶颈的地方使用它

至于浮点到字符串的转换（Disclamer：我用delphixe测试了下面的代码），而不是

procedure Test1;
var
  i: integer;
  S: string;

begin
  for i := 0 to 10 do begin
    S:= FloatToStr(i*1.31234);
    Writeln(S);
  end;
end;

LOCK INC     [EDX-skew].StrRec.refCnt

你可以用

procedure Test2;
var
  i: integer;
  S: string;
  Value: Extended;

begin
  SetLength(S, 64);
  for i := 0 to 10 do begin
    Value:= i*1.31234;
    FillChar(PChar(S)^, 64, 0);
    FloatToText(PChar(S), Value, fvExtended, ffGeneral, 15, 0);
    Writeln(S);
  end;
end;

产生相同的结果，但不在循环内分配内存。

请注意

function FloatToStr(Value: Extended): string; overload;
function FloatToStr(Value: Extended; const FormatSettings: TFormatSettings): string; overload;

---

FloatToStr的第一种形式不是线程安全的，因为它使用全局变量中包含的本地化信息。FloatToStr的第二种形式是线程安全的，它引用FormatSettings参数中包含的本地化信息。在调用FloatToStr的线程安全表单之前，必须使用本地化信息填充FormatSettings。要使用一组默认区域设置值填充FormatSettings，请调用GetLocaleFormatSettings。

非常感谢您迄今为止的知识和帮助。根据您的建议，我试图以一种避免堆分配的方式编写一个等效的FloatToStr方法。取得了一些成功。这决不是一个可靠的傻瓜式实现，只是一个简单的概念证明，可以扩展到更令人满意的解决方案

（还应注意使用XE6 64位）

实验结果/观察结果：

• CPU使用率%与启动的线程数成比例 （即每个线程=通过性能监视器最大化的1个内核）
• 正如预期的那样，随着更多线程的启动，每个线程的性能都有所下降（即执行任务所需的时间-请参阅代码）

时间只是粗略的平均值

• 8芯3.3GHz-1线程耗时4200ms。6根线每根耗时5200ms
• 8芯2.5GHz-1螺纹耗时4800ms。2=>4800ms，4=>5000ms，6=>6300ms

我没有计算整个多线程运行的总时间。只观察了CPU使用率%，并测量了单个线程的时间

就我个人而言，我觉得这确实有点可笑：）或者也许我做错了什么可怕的事

肯定有图书馆单位解决这些问题

守则：

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Generics.Collections,
  DateUtils;

type
  TfrmParallel = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTaskThread = class(TThread)
  private
    Fl: TList<double>;
  public
    procedure Add(l: TList<double>);
    procedure Execute; override;
  end;

var
  frmParallel: TfrmParallel;

implementation

{$R *.dfm}

{  TTaskThread  }

procedure TTaskThread.Add(l: TList<double>);
begin
  Fl := l;
end;

procedure TTaskThread.Execute;
var
  i, j: integer;
  s, xs: shortstring;

  FR: TFloatRec;
  V: double;
  Precision, D: integer;

  ZeroCount: integer;

  Start, Finish: TDateTime;

  procedure AppendByteToString(var Result: shortstring; const B: Byte);
  const
    A1 = '1';
    A2 = '2';
    A3 = '3';
    A4 = '4';
    A5 = '5';
    A6 = '6';
    A7 = '7';
    A8 = '8';
    A9 = '9';
    A0 = '0';
  begin
    if B = 49 then
      Result := Result + A1
    else if B = 50 then
      Result := Result + A2
    else if B = 51 then
      Result := Result + A3
    else if B = 52 then
      Result := Result + A4
    else if B = 53 then
      Result := Result + A5
    else if B = 54 then
      Result := Result + A6
    else if B = 55 then
      Result := Result + A7
    else if B = 56 then
      Result := Result + A8
    else if B = 57 then
      Result := Result + A9
    else
      Result := Result + A0;
  end;

  procedure AppendDP(var Result: shortstring);
  begin
    Result := Result + '.';
  end;

begin
  Precision := 9;
  D := 1000;
  Self.FreeOnTerminate := True;
  //
  Start := Now;
  for i := 0 to Fl.Count - 1 do
  begin
    V := Fl[i];   

//    //orignal way - just for testing
//    xs := shortstring(FloatToStrF(V, TFloatFormat.ffGeneral, Precision, D));

    //1. get float rec     
    FloatToDecimal(FR, V, TFloatValue.fvExtended, Precision, D);
    //2. check sign
    if FR.Negative then
      s := '-'
    else
      s := '';
    //2. handle negative exponent
    if FR.Exponent < 1 then
    begin
      AppendByteToString(s, 0);
      AppendDP(s);
      for j := 1 to Abs(FR.Exponent) do
        AppendByteToString(s, 0);
    end;      
    //3. count consecutive zeroes
    ZeroCount := 0;
    for j := Precision - 1 downto 0 do
    begin
      if (FR.Digits[j] > 48) and (FR.Digits[j] < 58) then
        Break;
      Inc(ZeroCount);
    end;
    //4. build string
    for j := 0 to Length(FR.Digits) - 1 do
    begin
      if j = Precision then
        Break;
      //cut off where there are only zeroes left up to precision
      if (j + ZeroCount) = Precision then
        Break;
      //insert decimal point - for positive exponent
      if (FR.Exponent > 0) and (j = FR.Exponent) then
        AppendDP(s);
      //append next digit
      AppendByteToString(s, FR.Digits[j]);
    end;      

//    //use just to test agreement with FloatToStrF
//    if s <> xs then
//      frmParallel.Memo1.Lines.Add(string(s + '|' + xs));

  end;
  Fl.Free;

  Finish := Now;
  //
  frmParallel.Memo1.Lines.Add(IntToStr(MillisecondsBetween(Start, Finish))); 
  //!YES LINE IS NOT THREAD SAFE!
end;

procedure TfrmParallel.Button1Click(Sender: TObject);
var
  i: integer;
  t: TTaskThread;
  l: TList<double>;
begin
  //pre generating the doubles is not required, is just a more useful test for me
  l := TList<double>.Create;
  for i := 0 to 10000000 do
    l.Add(Now/(-i-1)); //some double generation
  //
  t := TTaskThread.Create(True);
  t.Add(l);
  t.Start;
end;

end.

unitmain；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
Vcl.控件、Vcl.窗体、Vcl.对话框、Vcl.stdctrl、，
通用电气
procedure TTaskThread.Execute;
var
  i: integer;
  s: string;
begin
  for i := 0 to 1000000000 do
  begin
    s := FloatToStr(i*1.31234);
    Finalize(s);
  end;
end;

LOCK INC     [EDX-skew].StrRec.refCnt

     INC     [EDX-skew].StrRec.refCnt