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

来自：http://bbs.csdn.net/topics/330048800

---------------------------------------------------------

我们经常在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;

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.