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 := ;

  ShowMessage(IntToStr(ARecordTest.A));

end;

procedure TFmMain.btnEditConstClick(Sender: TObject);

var

  ARecordTest: TRecordTest;

begin

  ARecordTest.A := ;

  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 + ;

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[..**] 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 := ;

  ShowMessage(IntToStr(ARecordTest.A));

end;

procedure TFmMain.btnEditConstClick(Sender: TObject);

var

  ARecordTest: TRecordTest;

begin

  ARecordTest.A := ;

  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 :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  ConstTestB(ARecordTest);

end;

function TFmMain.ConstTestB(const ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  ConstTestC(ARecordTest);

end;

function TFmMain.ConstTestC(const ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  ConstTestD(ARecordTest);

end;

function TFmMain.ConstTestD(const ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  ConstTestE(ARecordTest);

end;

function TFmMain.ConstTestE(const ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  ConstTestF(ARecordTest);

end;

function TFmMain.ConstTestF(const ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

end;

function TFmMain.UnConstTestA(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  UnConstTestB(ARecordTest);

end;

function TFmMain.UnConstTestB(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  UnConstTestC(ARecordTest);

end;

function TFmMain.UnConstTestC(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  UnConstTestD(ARecordTest);

end;

function TFmMain.UnConstTestD(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  UnConstTestE(ARecordTest);

end;

function TFmMain.UnConstTestE(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  end;

  Result := j;

  UnConstTestF(ARecordTest);

end;

function TFmMain.UnConstTestF(ARecordTest: TRecordTest): Integer;

var

  i, j: Integer;

begin

  j := ARecordTest.A;

  for i :=  to  do

  begin

    j := j + ;

  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 := ;

  while ARecordTest.A <  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, , );

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) =  then Exit;

  for i := Low(FConstThread) to High(FConstThread) do

  begin

    FConstThread[i].Terminate;

  end;

  SetLength(FConstThread, );

  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) =  then Exit;

  for i := Low(FUnConstThread) to High(FUnConstThread) do

  begin

    FUnConstThread[i].Terminate;

  end;

  SetLength(FUnConstThread, );

  btnUnConstStart.Enabled := True;

  btnUnConstStop.Enabled := False;

end;

end.