转帖：DELPHI用const来提高应用程序在多核多线程下的性能,该如何解决

2012-02-27

转帖：DELPHI用const来提高应用程序在多核多线程下的性能原帖地址：http://hi.baidu.com/sqldebug/blog/item

转帖：DELPHI用const来提高应用程序在多核多线程下的性能
原帖地址：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参数的值

Delphi(Pascal) code

 
 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提高代码性能，大家可以把以下例子在自己电脑上测试。

Delphi(Pascal) code

 
 unit Main; 
  
 interface 
  
 uses 
   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.

[解决办法]
up
[解决办法]
up
[解决办法]
楼主知道得太多了
[解决办法]

Delphi(Pascal) code

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次
[解决办法]
mark
[解决办法]
本来就是这样。写函数和过程时const要尽量多用，这是编译器优化的方式，不是什么秘密，楼主发贴给100分的意义何在？
[解决办法]
惭愧，我是最近才开始尽量使用const的，因为最近才开始真正看书。
[解决办法]
探讨
Delphi(Pascal) codestring参数不const，也不会复制的吧，只有修改了才会导致复制procedure log(s:string);begin
  s:=当前时间+s;
  写入界面log区域(s);
  写入日志文件(s);end;
如果改为const，则：procedure log(const s:string);var
  t:string;begin
  t:=当前时?-

[解决办法]
同意楼主
[解决办法]
Up
[解决办法]
learn
[解决办法]
探讨
我写了一个测试程序，来验证sz_haitao的结果，不加const，string也是复制的，代码：
Delphi(Pascal) codeprocedure 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

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


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

[解决办法]
oo
[解决办法]
up
[解决办法]
up
[解决办法]
 学习
[解决办法]
up
[解决办法]
up
[解决办法]
学习了
[解决办法]
你写的那个关于测试不加const也会引起复制的那个例子是错误的。
delphi对字符串参数的处理方式是：当你的函数中的第一个地方使用了可能引起这个字符串被变更的时候，才会引起复制操作。
你上面的例子，使用了@AValue[1]这样的操作，这个操作恰恰是在程序编译优化时认为是可能会引起字符串变更的规则之一

正确的测试方法应该是
IntToHex(Integer(Pointer(AValue)), 4);
这种强制转换才不会导致 copy-on-write

不过，lz的关于函数参数使用const约束还是很有必要的

[解决办法]
如果有兴趣深究这个copy-on-write 机制，可以看看大富翁论坛的这个帖子 http://www.delphibbs.com/delphibbs/dispq.asp?lid=3251928
[解决办法]
楼主好XX
[解决办法]
值得 学习
[解决办法]
已阅
[解决办法]
好帖
[解决办法]
呵呵，帮顶下
其实C/C++的基础书里，高质量C/C++就提到过，一般DELPHI不看C/C++的书
[解决办法]
这个原则，在 C++ 也通用喔，不是只有 delphi 而已
[解决办法]
第六个...

[解决办法]
good
[解决办法]
up...

热点排行

.NET

转帖：DELPHI用const来提高应用程序在多核多线程下的性能,该如何解决