转帖：DELPHI用const来提高应用程序在多核多线程下的性能

Question

原帖地址：http://hi.baidu.com/sqldebug/blog/item/07f436104f53ea5af819b8be.html我们经常在DELPHI中用const来定义常量，用const来保护函数参数，其实在用const保护函数参数还有另一个更为重要的作用，提高应用程序的执行效率，尤其是在多线程多核下效果更明显。原因是：普通的函数参数如Add(AValue: string)，编译器在传入参数的时候先把变量复制一份，然后当成AValue传入Add，函数结束的时候进行销毁，你在参数上加了const，编译器在传入参数的时候不会进行复制，而是直接传地址，并在编译期间检查不能修改AValue值，我们知道DELPHI的内存管理在申请内存的时候是会加锁的，因此如果调用函数频繁，而且没有加const，这样会造成线程排队等候，性能会不如单线程，const只是对string、结构体等非基本类型有提高效率的作用，对Integer等基本类型（栈变量）不起作用。1、const的类型检查，以下代码可以修改const参数的值
procedure TFmMain.EditConstParameter(const ARecordTest: TRecordTest);
var
  pPoint: PRecordTest;
begin
  pPoint := @ARecordTest;
  pPoint.A := 1;
  ShowMessage(IntToStr(ARecordTest.A));
end;procedure TFmMain.btnEditConstClick(Sender: TObject);
var
  ARecordTest: TRecordTest;
begin
  ARecordTest.A := 0;
  EditConstParameter(ARecordTest);
  Inc(ARecordTest.A);
  ShowMessage(IntToStr(ARecordTest.A));
end;
2、const提高代码性能，使用const提高代码性能，大家可以把以下例子在自己电脑上测试。
unit Main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DateUtils;const
  WM_Complete = WM_USER + 1001;
type
  TRecordTest = record
    A: Integer;
    B: Integer;
    C: Integer;
    D: Integer;
    E: Integer;
    F: Integer;
    AStr: string;
    BStr: string;
    CStr: string;
    DStr: string;
    EStr: string;
    FStr: string;
    FCommit: array[0..15*1024*4] of Char;
  end;
  PRecordTest = ^TRecordTest;  TTestThread = class;  TFmMain = class(TForm)
    grpConst: TGroupBox;
    cbbConstThreadNum: TComboBox;
    lblThreadConst: TLabel;
    btnConstStart: TButton;
    btnConstStop: TButton;
    grp1: TGroupBox;
    lbl1: TLabel;
    cbbUnConstThreadNum: TComboBox;
    btnUnConstStart: TButton;
    btnUnConstStop: TButton;
    mmoText: TMemo;
    btnEditConst: TButton;
    procedure btnConstStartClick(Sender: TObject);
    procedure btnConstStopClick(Sender: TObject);
    procedure btnUnConstStartClick(Sender: TObject);
    procedure btnUnConstStopClick(Sender: TObject);
    procedure btnEditConstClick(Sender: TObject);
  private
    { Private declarations }
    FStartTime, FEndTime: TDateTime;
    FConstThread, FUnConstThread: array of TTestThread;
  protected
    procedure WMComplete(var Msg: TMessage); message WM_Complete;
  public
    {* 修改const函数变量 *}
    procedure EditConstParameter(const ARecordTest: TRecordTest);
    {* 线程测试函数 *}
    function ConstTestA(const ARecordTest: TRecordTest): Integer;
    function ConstTestB(const ARecordTest: TRecordTest): Integer;
    function ConstTestC(const ARecordTest: TRecordTest): Integer;
    function ConstTestD(const ARecordTest: TRecordTest): Integer;
    function ConstTestE(const ARecordTest: TRecordTest): Integer;
    function ConstTestF(const ARecordTest: TRecordTest): Integer;
    function UnConstTestA(ARecordTest: TRecordTest): Integer;
    function UnConstTestB(ARecordTest: TRecordTest): Integer;
    function UnConstTestC(ARecordTest: TRecordTest): Integer;
    function UnConstTestD(ARecordTest: TRecordTest): Integer;
    function UnConstTestE(ARecordTest: TRecordTest): Integer;
    function UnConstTestF(ARecordTest: TRecordTest): Integer;
  end;  TTestThread = class(TThread)
  private
    FConst: Boolean;
  protected
    procedure Execute; override;
  end;var
  FmMain: TFmMain;implementation{$R *.dfm}{ TFmMain }procedure TFmMain.EditConstParameter(const ARecordTest: TRecordTest);
var
  pPoint: PRecordTest;
begin
  pPoint := @ARecordTest;
  pPoint.A := 1;
  ShowMessage(IntToStr(ARecordTest.A));
end;procedure TFmMain.btnEditConstClick(Sender: TObject);
var
  ARecordTest: TRecordTest;
begin
  ARecordTest.A := 0;
  EditConstParameter(ARecordTest);
  Inc(ARecordTest.A);
  ShowMessage(IntToStr(ARecordTest.A));
end;function TFmMain.ConstTestA(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  ConstTestB(ARecordTest);
end;function TFmMain.ConstTestB(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  ConstTestC(ARecordTest);
end;function TFmMain.ConstTestC(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  ConstTestD(ARecordTest);
end;function TFmMain.ConstTestD(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  ConstTestE(ARecordTest);
end;function TFmMain.ConstTestE(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  ConstTestF(ARecordTest);
end;function TFmMain.ConstTestF(const ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
end;function TFmMain.UnConstTestA(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  UnConstTestB(ARecordTest);
end;function TFmMain.UnConstTestB(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  UnConstTestC(ARecordTest);
end;function TFmMain.UnConstTestC(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  UnConstTestD(ARecordTest);
end;function TFmMain.UnConstTestD(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  UnConstTestE(ARecordTest);
end;function TFmMain.UnConstTestE(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
  UnConstTestF(ARecordTest);
end;function TFmMain.UnConstTestF(ARecordTest: TRecordTest): Integer;
var
  i, j: Integer;
begin
  j := ARecordTest.A;
  for i := 0 to 5 do
  begin
    j := j + 1;
  end;
  Result := j;
end;procedure TFmMain.WMComplete(var Msg: TMessage);
begin
  FEndTime := Now;
  mmoText.Lines.Add('Spend Time: ' + IntToStr(MilliSecondsBetween(FStartTime, FEndTime)));
end;{ TTestThread }procedure TTestThread.Execute;
var
  ARecordTest: TRecordTest;
begin
  inherited;
  ARecordTest.A := 0;
  while ARecordTest.A < 1000000 do
  begin
    if FConst then
    begin
      Inc(ARecordTest.A);
      FmMain.ConstTestA(ARecordTest);
    end
    else
    begin
      Inc(ARecordTest.A);
      FmMain.UnConstTestA(ARecordTest);
    end;
  end;
  SendMessage(FmMain.Handle, WM_Complete, 0, 0);
end;procedure TFmMain.btnConstStartClick(Sender: TObject);
var
  i: Integer;
begin
  FStartTime := Now;
  SetLength(FConstThread, StrToInt(cbbConstThreadNum.Text));
  for i := Low(FConstThread) to High(FConstThread) do
  begin
    FConstThread[i] := TTestThread.Create(True);
    FConstThread[i].FreeOnTerminate := True;
    FConstThread[i].FConst := True;
  end;
  for i := Low(FConstThread) to High(FConstThread) do
  begin
    FConstThread[i].Resume;
  end;
  btnConstStart.Enabled := False;
  btnConstStop.Enabled := True;
end;procedure TFmMain.btnConstStopClick(Sender: TObject);
var
  i: Integer;
begin
  if Length(FConstThread) = 0 then Exit;
  for i := Low(FConstThread) to High(FConstThread) do
  begin
    FConstThread[i].Terminate;
  end;
  SetLength(FConstThread, 0);
  btnConstStart.Enabled := True;
  btnConstStop.Enabled := False;
end;procedure TFmMain.btnUnConstStartClick(Sender: TObject);
var
  i: Integer;
begin
  FStartTime := Now;
  SetLength(FUnConstThread, StrToInt(cbbUnConstThreadNum.Text));
  for i := Low(FUnConstThread) to High(FUnConstThread) do
  begin
    FUnConstThread[i] := TTestThread.Create(True);
    FUnConstThread[i].FreeOnTerminate := True;
    FUnConstThread[i].FConst := False;
  end;
  for i := Low(FUnConstThread) to High(FUnConstThread) do
  begin
    FUnConstThread[i].Resume;
  end;
  btnUnConstStart.Enabled := False;
  btnUnConstStop.Enabled := True;
end;procedure TFmMain.btnUnConstStopClick(Sender: TObject);
var
  i: Integer;
begin
  if Length(FUnConstThread) = 0 then Exit;
  for i := Low(FUnConstThread) to High(FUnConstThread) do
  begin
    FUnConstThread[i].Terminate;
  end;
  SetLength(FUnConstThread, 0);
  btnUnConstStart.Enabled := True;
  btnUnConstStop.Enabled := False;
end;end.

Answer 1

string参数不const，也不会复制的吧，只有修改了才会导致复制procedure log(s:string);
begin
  s:=当前时间+s;
  写入界面log区域(s);
  写入日志文件(s);
end;
如果改为const，则：
procedure log(const s:string);
var
  t:string;
begin
  t:=当前时间+s;
  写入界面log区域(t);
  写入日志文件(t);
end;
需要多定义一个变量
或
procedure log(const s:string);
begin
  写入界面log区域(当前时间+s);
  写入日志文件(当前时间+s);
end;
当前时间 被执行了2次

Answer 2

本来就是这样。写函数和过程时const要尽量多用，这是编译器优化的方式，不是什么秘密，楼主发贴给100分的意义何在？

Answer 3

惭愧，我是最近才开始尽量使用const的，因为最近才开始真正看书。

Answer 4

函数参数使用const，就是为了防止在函数内误操作导致输入参数被改，楼主想表达的应该也是这个意思，用于提高可靠性

Answer 5

我写了一个测试程序，来验证sz_haitao的结果，不加const，string也是复制的，代码：procedure TForm1.Add(AValue: string);
begin
  ShowMessage('UnConst:' + IntToStr(Integer(@AValue[1])));
  AValue := 'Test2';
  ShowMessage('UnConst Edit:' + IntToStr(Integer(@AValue[1])));
end;procedure TForm1.AddConst(const AValue: string);
begin
  ShowMessage('Const:' + IntToStr(Integer(@AValue[1])));
end;procedure TForm1.btn1Click(Sender: TObject);
var
  sStr: string;
begin
  sStr := 'Test';
  ShowMessage('Original:' + IntToStr(Integer(@sStr[1])));
  Add(sStr);
  AddConst(sStr);
end;运行结果：
Original:9780436
UnConst:9781208
UnConst Edit:9781208
Const:9780436

Answer 6

也许调用参数和一般的变量赋值，string使用机制不一样了

Answer 7

我認為在性能方面，不考慮多線程情況下，string參數有加const修飾符，可以避免try finally end的開銷。
若沒有加const的string變量，delphi會自動加try finally end語句塊(因為delphi認為你可能會去修改它)，以保證順利釋放string的內存占用。
這點可以透過cpu view了解到。

Answer 8

我也刚看到const,有空研究一下先谢谢了

Answer 9

你写的那个关于测试不加const也会引起复制的那个例子是错误的。
delphi对字符串参数的处理方式是：当你的函数中的第一个地方使用了可能引起这个字符串被变更的时候，才会引起复制操作。
你上面的例子，使用了@AValue[1]这样的操作，这个操作恰恰是在程序编译优化时认为是可能会引起字符串变更的规则之一正确的测试方法应该是
IntToHex(Integer(Pointer(AValue)), 4);
这种强制转换才不会导致 copy-on-write不过，lz的关于函数参数使用const约束还是很有必要的

Answer 10

如果有兴趣深究这个copy-on-write 机制，可以看看大富翁论坛的这个帖子 http://www.delphibbs.com/delphibbs/dispq.asp?lid=3251928

Answer 11

这个原则，在 C++ 也通用喔，不是只有 delphi 而已

Answer 12

const用于string不安全，原因是const的实参的引用记数不增加，有可能出现形参仍然在使用，实参已经释放的状况，起码某些版本的delphi的编译器是这样处理的。