Использование классов внутри потоков

[frosich]

Здравствуйте!
Пытаюсь полностью использовать ресурс процессора (4 ядра).
Для этого создаю 4 потока, которые должны выполнять одинаковые операции с разными элементами массива, являющегося полем класса.
Каждый поток по очереди (в мъютексе) берёт текущее значение индекса массива и увеличивает индекс (объявлен как class var в классе TCalculateThread). Если индекс не превышает размер массива, то выполняется метод класса, производящий нужные действия (или если говорить точно, то массив в классе многомерный и метод выполняется в циклах). При этом операции при разных индексах абсолютно независимы.

При этом % занятости процессора практически не отличается от варианта без использования потоков.

Вопрос: почему не получается занять процессор полностью? Может ли это быть результатом использования классов?

Код описывающий потоки:

const
  NThreads = 4;
  NProcessors = 4;

type
  TDoWorkProcedure = procedure(i: integer) of Object;

type
  TCalculateThread = class(TThread)
  protected
    class var
      FGetNextTaskMutex: THandle;
      FStopThreadMutex: THandle;
      FCurrentI: integer;
      FStepI: integer;
      FMaxI: integer;
      FCount: integer;
      FDoWork: TDoWorkProcedure;
      FProgressHandle: THandle;
    var
      FI: integer;
    procedure GetNextTask;
    procedure StopThreadCount;
    procedure Execute; override;
  end;

type
  TProceedDataByThreads = class(TObject)
  protected
    FThread: array[1..NThreads] of TCalculateThread;
  public
    constructor Create(StartI, EndI, StepI: integer; vProgressHandle: THandle); overload;
    procedure DoWork(i: integer); virtual; abstract;
    procedure DoThreads;
  end;

type
  TMovePointProcess = class(TProceedDataByThreads)
  protected
    FMinJ, FMaxJ, FMinL, FMaxL, FMinW, FMaxW: integer;
    FPrevMesh: TRectangularMesh;
    FDim3: boolean;
    FBounds: TBounds;
  public
    constructor Create(StartI, StartJ, StartL, StartW, EndI, EndJ, EndL, EndW: integer;
                       var vPrevMesh: TRectangularMesh; vDim3: boolean; vBounds: TBounds;
                       vProgressHandle: THandle); overload;
    procedure DoWork(i: integer); override;
  end;

implementation

uses Forms, ProgressWindowUnit;

procedure TCalculateThread.GetNextTask;
begin
  case WaitForSingleObject(FGetNextTaskMutex, INFINITE) of
    WAIT_ABANDONED:
      ShowMessage('WAIT_ABANDONED');
    WAIT_OBJECT_0:
      begin
        FI:=FCurrentI;
        FCurrentI:=FCurrentI+1;
        PostMessage(FProgressHandle, WM_UPDATE_PROGRESS, 0, 0);
      end;
    WAIT_TIMEOUT:
      ShowMessage('WAIT_TIMEOUT');
  end;
  ReleaseMutex(FGetNextTaskMutex);
end;

procedure TCalculateThread.StopThreadCount;
begin
  case WaitForSingleObject(FStopThreadMutex, INFINITE) of
    WAIT_ABANDONED:
      ShowMessage('WAIT_ABANDONED');
    WAIT_OBJECT_0:
      begin
        FCount:=FCount-1;
      end;
    WAIT_TIMEOUT:
      ShowMessage('WAIT_TIMEOUT');
  end;
  ReleaseMutex(FStopThreadMutex);
end;

procedure TCalculateThread.Execute;
begin
  GetNextTask;
  while FI<=FMaxI do
    begin
      FDoWork(FI);
      GetNextTask;
    end;
  StopThreadCount;
end;

constructor TProceedDataByThreads.Create(StartI, EndI, StepI: integer;
                                         vProgressHandle: THandle);
begin
  inherited Create;
  TCalculateThread.FProgressHandle:=vProgressHandle;
  TCalculateThread.FGetNextTaskMutex:= 0;
  TCalculateThread.FStopThreadMutex:= 0;
  TCalculateThread.FCount:= NThreads;
  TCalculateThread.FCurrentI:=StartI;
  TCalculateThread.FStepI:=StepI;
  TCalculateThread.FMaxI:=EndI;
  TCalculateThread.FGetNextTaskMutex:=CreateMutex(nil,false,'GetNextTaskMutex');
  TCalculateThread.FStopThreadMutex:=CreateMutex(nil,false,'StopThreadMutex');
end;

procedure TProceedDataByThreads.DoThreads;
var
  i: integer;
  MainThread: THandle;
begin
  MainThread:=GetCurrentThread;
  for i := Low(FThread) to High(FThread) do
    begin
      FThread[i]:=TCalculateThread.Create(true);
      //SetThreadAffinityMask(FThread[i].Handle,i mod NProcessors);
      //SetThreadIdealProcessor(FThread[i].Handle,i mod NProcessors);
      FThread[i].Start;
    end;
  SetThreadPriority(MainThread,THREAD_PRIORITY_IDLE);
  while TCalculateThread.FCount<>0 do
    begin
      Sleep(100);
      Application.ProcessMessages;
      Sleep(0);
    end;
  SetThreadPriority(MainThread,THREAD_PRIORITY_NORMAL);
  if TCalculateThread.FGetNextTaskMutex<>0 then CloseHandle(TCalculateThread.FGetNextTaskMutex);
  if TCalculateThread.FStopThreadMutex<>0 then CloseHandle(TCalculateThread.FStopThreadMutex);
  for i := Low(FThread) to High(FThread) do
    begin
      FThread[i].Terminate;
      FThread[i].WaitFor;
      FreeAndNil(FThread[i]);
    end;
end;

[frosich]

constructor TMovePointProcess.Create(StartI, StartJ, StartL, StartW, EndI, EndJ, EndL, EndW: integer;
                                     var vPrevMesh: TRectangularMesh; vDim3: boolean; vBounds: TBounds;
                                     vProgressHandle: THandle);
begin
  inherited Create(StartI, EndI, 1, vProgressHandle);
  FMinJ:=StartJ;
  FMinL:=StartL;
  FMinW:=StartW;
  FMaxJ:=EndJ;
  FMaxL:=EndL;
  FMaxW:=EndW;
  FDim3:=vDim3;
  FPrevMesh:=vPrevMesh;
  FBounds:=vBounds;
  TCalculateThread.FDoWork:=DoWork;
  DoThreads;
end;

procedure TMovePointProcess.DoWork(i: Integer);
var
  w,j,l: integer;
begin
  for j:=FMinJ to FMaxJ do
    for l:=FMinL to FMaxL do
      for w := FMinW to FMaxW do
        begin
          FPrevMesh.MovePoint(w,i,j,l,FBounds.Bound[w],FDim3);
        end;
end;

Код использования потоков

MovePointProcess:=TMovePointProcess.Create(1,1,1,0,nx-2,ny-2,nz-2,Bounds.BoundsNumber-1,PrevMesh,FDim3,Bounds,ProgressWindow.Handle);
FreeAndNil(MovePointProcess);

[Slym]

1. приаттаченый проект приятнее читать
2. почему не критическая секция?
3. не принято делать работу в Create убери оттуда DoThreads
4. ты уверен что FPrevMesh.MovePoint не лезет в гуй?
5. попытка оптимизировать экстенсивным способом... много калла в твоем 4 этажном цикле, для скорости кал иногда нужно развернуть, убрать стековую подачу параметров...
6. может репорт PostMessage частый? за модить так на 10 попробуй
в общем без проекта и секундомера не обойтись

[frosich]

1. приаттаченый проект приятнее читать

Весь проект большой, это лишь маленькая часть.

2. почему не критическая секция?

Проект представляет собой package, используемый в других package-ах, поэтому именно мьютекс

3. не принято делать работу в Create убери оттуда DoThreads

Переместил, но естественно это ничего не поменяло

4. ты уверен что FPrevMesh.MovePoint не лезет в гуй?

Да, уверен, это чисто вычислительный метод.

5. попытка оптимизировать экстенсивным способом... много калла в твоем 4 этажном цикле, для скорости кал иногда нужно развернуть, убрать стековую подачу параметров...

Наверное в этом и есть проблема, попробую убрать класс, или вытащить ссылки на данные через указатели.

6. может репорт PostMessage частый? за модить так на 10 попробуй

Попробовал вообще закомментировать эту строчку: не помогает.

Спасибо за помощь.

[Slym]

var Data - можно заменить на var i:integer;

unit Unit2;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,SyncObjs,Dialogs,Forms;

type
  TProcThreadMaster = class;
  TProcThread = class(TThread)
  private
    FMaster: TProcThreadMaster;
  protected
    procedure Execute; override;
  public
    constructor Create(Master:TProcThreadMaster;CreateSuspended: Boolean);

  end;

  TProcThreadMaster = class(TObject)
  protected
    FThreads: TThreadList;
    CS:TCriticalSection;
    FCurrentI,FMaxI,FStepI: integer;
    FProgressHandle:THandle;
    function GetData(var Data):boolean;virtual;
    procedure ProcessData(var Data);virtual;
    procedure OnThreadTerminate(Sender: TObject);
  public
    constructor Create(StartI, EndI, StepI: integer; vProgressHandle: THandle); overload;
    destructor Destroy;override;
    procedure DoThreads;
  end;

type
  TMovePointProcess = class(TProcThreadMaster)
  protected
    FMinJ, FMaxJ, FMinL, FMaxL, FMinW, FMaxW: integer;
    FPrevMesh: TRectangularMesh;
    FDim3: boolean;
    FBounds: TBounds;
    procedure ProcessData(var Data);override;
  public
    constructor Create(StartI, StartJ, StartL, StartW, EndI, EndJ, EndL, EndW: integer;
                       var vPrevMesh: TRectangularMesh; vDim3: boolean; vBounds: TBounds;
                       vProgressHandle: THandle); overload;
  end;

implementation


constructor TProcThread.Create(Master:TProcThreadMaster;CreateSuspended: Boolean);
begin
  FMaster:=Master;
  inherited Create(CreateSuspended);
end;

procedure TProcThread.Execute;
var Data:Pointer;
begin
  while not Terminated and FMaster.GetData(Data) do
  begin
    FMaster.ProcessData(Data);
  end;
end;

constructor TProcThreadMaster.Create(StartI, EndI, StepI: integer; vProgressHandle: THandle);
begin
  inherited Create;
  FThreads:=TThreadList.Create;
  CS:=TCriticalSection.Create;
  FProgressHandle:=vProgressHandle;

  FCurrentI:=StartI;
  FStepI:=StepI;
  FMaxI:=EndI;
  FProgressHandle:=vProgressHandle;
end;

destructor TProcThreadMaster.Destroy;
begin
  CS.Free;
  FThreads.Free;
  inherited;
end;


function TProcThreadMaster.GetData(var Data):boolean;
begin
  CS.Enter;
  try
    integer(Data):=FCurrentI;
    inc(FCurrentI,FStepI);
  finally
    CS.Leave;
  end;
  result:=integer(Data)<FMaxI;
end;

procedure TProcThreadMaster.ProcessData(var Data);
begin
  PostMessage(FProgressHandle, WM_UPDATE_PROGRESS, integer(Data), 0);
end;

procedure TProcThreadMaster.OnThreadTerminate(Sender: TObject);
begin
  FThreads.Remove(Sender);
end;

procedure TProcThreadMaster.DoThreads;
var
  SystemInfo: TSystemInfo;
  i: integer;
  Thread:TProcThread;
  Terminated:boolean;
begin
  GetSystemInfo(SystemInfo);
  for i:=0 to SystemInfo.dwNumberOfProcessors-1 do
  begin
    Thread:=TProcThread.Create(self,true);
    Thread.OnTerminate:=OnThreadTerminate;
    Thread.FreeOnTerminate:=true;
    FThreads.Add(Thread);
    SetThreadIdealProcessor(Thread.Handle,i);
    Thread.Resume;
  end;
  SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_IDLE);
  Terminated:=false;
  while not Terminated do
  begin
    Terminated:=FThreads.LockList.Count=0;
    FThreads.UnlockList;
    Sleep(0);
    Application.ProcessMessages;
  end;
  SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_NORMAL);
end;



constructor TMovePointProcess.Create(StartI, StartJ, StartL, StartW, EndI, EndJ, EndL, EndW: integer;
                                     var vPrevMesh: TRectangularMesh; vDim3: boolean; vBounds: TBounds;
                                     vProgressHandle: THandle);
begin
  inherited Create(StartI, EndI, 1, vProgressHandle);
  FMinJ:=StartJ;
  FMinL:=StartL;
  FMinW:=StartW;
  FMaxJ:=EndJ;
  FMaxL:=EndL;
  FMaxW:=EndW;
  FDim3:=vDim3;
  FPrevMesh:=vPrevMesh;
  FBounds:=vBounds;
end;

procedure TMovePointProcess.ProcessData(var Data);
var i,w,j,l: integer;
begin
  i:=integer(Data);
  for j:=FMinJ to FMaxJ do
    for l:=FMinL to FMaxL do
      for w := FMinW to FMaxW do
        begin
          FPrevMesh.MovePoint(w,i,j,l,FBounds.Bound[w],FDim3);
        end;
  inherited;
end;

end.

[frosich]

Добрый вечер!
Честно говоря не понял что принципиально должны изменить предложенные изменения, кроме повышения компактности и элегантности кода.
Для проверки гипотезы

5. попытка оптимизировать экстенсивным способом... много калла в твоем 4 этажном цикле, для скорости кал иногда нужно развернуть, убрать стековую подачу параметров...

Заменил

FPrevMesh.MovePoint(w,i,j,l,FBounds.Bound[w],FDim3);

на

a:=0.5665;
b:=0.67685;
for n:= 0 to 1000000 do
c:=a*b;

Получил полную загрузку ЦП, что подтвердило гипотезу (если я её правильно понял), кроме передачи параметра i с ним вроде всё в порядке.
Сейчас перерабатываю вызов:

FPrevMesh.MovePoint(w,i,j,l,FBounds.Bound[w],FDim3);

Будет просто процедура, а внутренние поля класса (массивы) надеюсь вытащить как указатели. О результатах напишу. Ещё раз спасибо.

[Slym]

Сообщение от frosich

Добрый вечер!
Честно говоря не понял что принципиально должны изменить предложенные изменения, кроме повышения компактности и элегантности кода.

Говорят некрасивые самолеты не летают...

Покажи лучше содержимое
FPrevMesh.MovePoint(w,i,j,l,FBounds .Bound[w],FDim3);

[frosich]

Покажи лучше содержимое
FPrevMesh.MovePoint(w,i,j,l,FBounds .Bound[w],FDim3);

procedure TRectangularMesh.MovePoint(w, i, j, l: integer; Bound: TBound; dim3: boolean = true);
var
  x,y,z,AbsShift,NewCoordinate,BoundCalculates: array of double;
  mina,minc: double;
  k,v,m: integer;
begin
  if dim3 then m:=7 else m:=5;
  SetLength(x,m);
  SetLength(y,m);
  SetLength(z,m);
  SetLength(BoundCalculates,m-1);
  SetLength(AbsShift,m-1);
  SetLength(NewCoordinate,m-1);
  if FContained[0,i,j,l] or (w=0) then
    begin
      x[0]:=(i-round(nx/2))*Fhx-Bound.Center.x;
      y[0]:=(j-1-round(ny/2))*Fhy-Bound.Center.y;
      x[1]:=(i-1-round(nx/2))*Fhx-Bound.Center.x;
      y[1]:=(j-round(ny/2))*Fhy-Bound.Center.y;
      x[2]:=FMeshPoints[i,j,l].x-Bound.Center.x;
      y[2]:=FMeshPoints[i,j,l].y-Bound.Center.y;
      x[3]:=(i+1-round(nx/2))*Fhx-Bound.Center.x;
      y[3]:=(j-round(ny/2))*Fhy-Bound.Center.y;
      x[4]:=(i-round(nx/2))*Fhx-Bound.Center.x;
      y[4]:=(j+1-round(ny/2))*Fhy-Bound.Center.y;
      if dim3 then
        begin
          x[5]:=(i-round(nx/2))*Fhx-Bound.Center.x;
          y[5]:=(j-round(ny/2))*Fhy-Bound.Center.y;
          x[6]:=(i-round(nx/2))*Fhx-Bound.Center.x;
          y[6]:=(j-round(ny/2))*Fhy-Bound.Center.y;
          z[0]:=(l-round(nz/2))*Fhz-Bound.Center.z;
          z[1]:=(l-round(nz/2))*Fhz-Bound.Center.z;
          z[2]:=FMeshPoints[i,j,l].z-Bound.Center.z;
          z[3]:=(l-round(nz/2))*Fhz-Bound.Center.z;
          z[4]:=(l-round(nz/2))*Fhz-Bound.Center.z;
          z[5]:=(l-1-round(nz/2))*Fhz-Bound.Center.z;
          z[6]:=(l+1-round(nz/2))*Fhz-Bound.Center.z;
        end
      else
        begin
          z[0]:=0;
          z[1]:=0;
          z[2]:=0;
          z[3]:=0;
          z[4]:=0;
        end;
      if w=0 then FMeshPoints[i,j,l].nbound:=-1;
      BoundCalculates[0]:= CalculateF(Bound,x[2],y[2],z[2]);
      if w=0 then if BoundCalculates[0]>=0 then FContained[0,i,j,l]:=true;
      if w>0 then
        begin
          if BoundCalculates[0]>0 then FContained[0,i,j,l]:=false;
          if BoundCalculates[0]>=0 then FContained[w,i,j,l]:=Bound.IsItHaveMesh;
        end;
      if BoundCalculates[0]=0 then
        begin
          FMeshPoints[i,j,l].nbound:=w;
        end;
      BoundCalculates[1]:=BoundCalculates[0]*CalculateF(Bound,x[4],y[4],z[4]);
      BoundCalculates[2]:=BoundCalculates[0]*CalculateF(Bound,x[1],y[1],z[1]);
      BoundCalculates[3]:=BoundCalculates[0]*CalculateF(Bound,x[3],y[3],z[3]);
      if dim3 then
        begin
          BoundCalculates[4]:=BoundCalculates[0]*CalculateF(Bound,x[5],y[5],z[5]);
          BoundCalculates[5]:=BoundCalculates[0]*CalculateF(Bound,x[6],y[6],z[6]);
        end;
    BoundCalculates[0]:=BoundCalculates[0]*CalculateF(Bound,x[0],y[0],z[0]);

[frosich]

 for k:=0 to m-2 do
        begin
          NewCoordinate[k]:=0;
          AbsShift[k]:=0;
        end;
      if BoundCalculates[0]<0 then
        begin
          NewCoordinate[0]:=Solve(Bound,2,x[2],z[2],y[2],y[0]);
          AbsShift[0]:=abs(NewCoordinate[0]-y[2]);
          if AbsShift[0]>Fhy/2 then {условие невозможности сдвига}
            begin
              NewCoordinate[0]:=0;
              AbsShift[0]:=0;
            end;
        end;
      if BoundCalculates[1]<0 then
        begin
          NewCoordinate[1]:=Solve(Bound,2,x[2],z[2],y[2],y[4]);
          AbsShift[1]:=abs(NewCoordinate[1]-y[2]); 
          if AbsShift[1]>Fhy/2 then
            begin
              NewCoordinate[1]:=0;
              AbsShift[1]:=0;
            end;
        end;
      if BoundCalculates[2]<0 then
        begin
          NewCoordinate[2]:=Solve(Bound,1,y[2],z[2],x[2],x[1]);
          AbsShift[2]:=abs(NewCoordinate[2]-x[2]);
          if AbsShift[2]>Fhx/2 then
            begin
              NewCoordinate[2]:=0;
              AbsShift[2]:=0;
            end;
        end;
      if BoundCalculates[3]<0 then
        begin
          NewCoordinate[3]:=Solve(Bound,1,y[2],z[2],x[2],x[3]);
          AbsShift[3]:=abs(NewCoordinate[3]-x[2]);
          if AbsShift[3]>Fhx/2 then
            begin
              NewCoordinate[3]:=0;
              AbsShift[3]:=0;
            end;
        end;
      if dim3 then
        begin
          if BoundCalculates[4]<0 then 
            begin
              NewCoordinate[4]:=Solve(Bound,3,x[2],y[2],z[2],z[5]);
              AbsShift[4]:=abs(NewCoordinate[4]-z[2]);
              if AbsShift[4]>Fhz/2 then
                begin
                  NewCoordinate[4]:=0;
                  AbsShift[4]:=0;
                end;
            end;
          if BoundCalculates[5]<0 then 
            begin
              NewCoordinate[5]:=Solve(Bound,3,x[2],y[2],z[2],z[6]);
              AbsShift[5]:=abs(NewCoordinate[5]-z[2]);
              if AbsShift[5]>Fhz/2 then
                begin
                  NewCoordinate[5]:=0;
                  AbsShift[5]:=0;
                end;
            end;
        end;
      mina:=AbsShift[0];
      minc:=NewCoordinate[0];
      v:=0;
      for k:=1 to m-2 do
        begin
          if (AbsShift[k]<>0) and (mina>=AbsShift[k]) then
            begin
              mina:=AbsShift[k];
              minc:=NewCoordinate[k];
              v:=k;
            end;
          if mina=0 then
            begin
              mina:=AbsShift[k];
              minc:=NewCoordinate[k];
              v:=k;
            end;
        end;
      if (mina<>0) and (FMeshPoints[i,j,l].nbound=-1) then
        begin
          case v of
            0: FMeshPoints[i,j,l].y:=minc+Bound.Center.y;
            1: FMeshPoints[i,j,l].y:=minc+Bound.Center.y;
            2: FMeshPoints[i,j,l].x:=minc+Bound.Center.x;
            3: FMeshPoints[i,j,l].x:=minc+Bound.Center.x;
            4: if dim3 then FMeshPoints[i,j,l].z:=minc+Bound.Center.z;
            5: if dim3 then FMeshPoints[i,j,l].z:=minc+Bound.Center.z;
          end;
          FContained[0,i,j,l]:=true;
          FMeshPoints[i,j,l].nbound:=w;
          if w>0 then FContained[w,i,j,l]:=Bound.IsItHaveMesh;
        end;
    end;
end;

[frosich]

CalculateF

вычисляет значение заданной "функции" (не в смысле языковой конструкции, а в математическом смысле) в точке.

Попытка переделать метод в просто процедуру и использовать указатели на ячейки массивов не увенчалась успехом. По прежнему используется одно ядро (судя по загрузке ЦП).
Новые данные:
Если вставить в процедуру

FPrevMesh.MovePoint(w,i,j,l,FBounds .Bound[w],FDim3);

Код:

a:=0.5665;
b:=0.67685;
for n:= 0 to 1000000 do
c:=a*b;

то ЦП грузится на 100%.