pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

multithreadprocs: clean up

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@937 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
mgaertner
2009-08-20 15:05:00 +00:00
parent 5734f36fae
commit 6b156e32d7
2 changed files with 36 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/multithreadprocs/mtpcpu.pas
View File

@@ -15,6 +15,7 @@
unit MTPCPU; unit MTPCPU;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$inline on}
interface interface
@@ -29,8 +30,8 @@ uses ctypes;
function GetSystemThreadCount: integer; function GetSystemThreadCount: integer;
procedure CallLocalProc(Func: pointer; Frame: Pointer; Param1: PtrInt; procedure CallLocalProc(AProc, Frame: Pointer; Param1: PtrInt;
Param2, Param3: Pointer);inline; Param2, Param3: Pointer); inline;
implementation implementation
@@ -90,13 +91,13 @@ end;
end; end;
{$ENDIF} {$ENDIF}
procedure CallLocalProc(Func: pointer; Frame: Pointer; Param1: PtrInt; procedure CallLocalProc(AProc, Frame: Pointer; Param1: PtrInt;
Param2, Param3: Pointer); inline; Param2, Param3: Pointer); inline;
type type
PointerLocal = procedure(_EBP: Pointer; Param1: PtrInt; PointerLocal = procedure(_EBP: Pointer; Param1: PtrInt;
Param2, Param3: Pointer); Param2, Param3: Pointer);
begin begin
PointerLocal(Func)(Frame, Param1, Param2, Param3); PointerLocal(AProc)(Frame, Param1, Param2, Param3);
end; end;
end. end.

65
components/multithreadprocs/mtprocs.pas
View File

@@ -90,10 +90,6 @@ type
Item: TMultiThreadProcItem) of object; Item: TMultiThreadProcItem) of object;
TMTProcedure = procedure(Index: PtrInt; Data: Pointer; TMTProcedure = procedure(Index: PtrInt; Data: Pointer;
Item: TMultiThreadProcItem); Item: TMultiThreadProcItem);
TMTLocalProc = record
Proc: Pointer; // must be a local procedure of a procedure (not a method)
Frame: Pointer;
end;
{ TProcThreadGroup { TProcThreadGroup
Each task creates a new group of threads. Each task creates a new group of threads.
@@ -122,7 +118,7 @@ type
FStartIndex: PtrInt; FStartIndex: PtrInt;
FState: TMTPGroupState; FState: TMTPGroupState;
FTaskData: Pointer; FTaskData: Pointer;
FTaskLocalProc: TMTLocalProc; FTaskFrame: Pointer;
FTaskMethod: TMTMethod; FTaskMethod: TMTMethod;
FTaskProcedure: TMTProcedure; FTaskProcedure: TMTProcedure;
FThreadCount: PtrInt; FThreadCount: PtrInt;
@@ -147,7 +143,7 @@ type
property TaskData: Pointer read FTaskData; property TaskData: Pointer read FTaskData;
property TaskMethod: TMTMethod read FTaskMethod; property TaskMethod: TMTMethod read FTaskMethod;
property TaskProcedure: TMTProcedure read FTaskProcedure; property TaskProcedure: TMTProcedure read FTaskProcedure;
property TaskLocalProcedure: TMTLocalProc read FTaskLocalProc; property TaskFrame: Pointer read FTaskFrame;
property MaxThreads: PtrInt read FMaxThreads; property MaxThreads: PtrInt read FMaxThreads;
property StarterItem: TMultiThreadProcItem read FStarterItem; property StarterItem: TMultiThreadProcItem read FStarterItem;
end; end;
@@ -171,7 +167,7 @@ type
procedure SetMaxThreadCount(const AValue: PtrInt); procedure SetMaxThreadCount(const AValue: PtrInt);
procedure CleanTerminatedThreads; procedure CleanTerminatedThreads;
procedure DoParallelIntern(const AMethod: TMTMethod; procedure DoParallelIntern(const AMethod: TMTMethod;
const AProc: TMTProcedure; const ALocalProc: TMTLocalProc; const AProc: TMTProcedure; const AFrame: Pointer;
StartIndex, EndIndex: PtrInt; StartIndex, EndIndex: PtrInt;
Data: Pointer = nil; MaxThreads: PtrInt = 0); Data: Pointer = nil; MaxThreads: PtrInt = 0);
public public
@@ -188,7 +184,7 @@ type
Data: Pointer = nil; MaxThreads: PtrInt = 0); inline; Data: Pointer = nil; MaxThreads: PtrInt = 0); inline;
// experimental // experimental
procedure DoParallelLocalProc(const AProc: Pointer; procedure DoParallelLocalProc(const LocalProc: Pointer;
StartIndex, EndIndex: PtrInt; StartIndex, EndIndex: PtrInt;
Data: Pointer = nil; MaxThreads: PtrInt = 0); // do not make this inline! Data: Pointer = nil; MaxThreads: PtrInt = 0); // do not make this inline!
public public
@@ -199,9 +195,6 @@ type
var var
ProcThreadPool: TProcThreadPool = nil; ProcThreadPool: TProcThreadPool = nil;
const
MTLocalProcNil: TMTLocalProc = (Proc: nil; Frame: nil);
implementation implementation
{ TMultiThreadProcItem } { TMultiThreadProcItem }
@@ -433,12 +426,14 @@ end;
procedure TProcThreadGroup.Run(Index: PtrInt; Data: Pointer; procedure TProcThreadGroup.Run(Index: PtrInt; Data: Pointer;
Item: TMultiThreadProcItem); inline; Item: TMultiThreadProcItem); inline;
begin begin
if Assigned(FTaskProcedure) then if Assigned(FTaskFrame) then begin
FTaskProcedure(Index,Data,Item) CallLocalProc(FTaskProcedure,FTaskFrame,Index,Data,Item)
else if Assigned(FTaskMethod) then end else begin
FTaskMethod(Index,Data,Item) if Assigned(FTaskProcedure) then
else FTaskProcedure(Index,Data,Item)
CallLocalProc(FTaskLocalProc.Proc,FTaskLocalProc.Frame,Index,Data,Item); else
FTaskMethod(Index,Data,Item)
end;
end; end;
procedure TProcThreadGroup.IndexComplete(Index: PtrInt); procedure TProcThreadGroup.IndexComplete(Index: PtrInt);
@@ -656,29 +651,29 @@ procedure TProcThreadPool.DoParallel(const AMethod: TMTMethod;
StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt);
begin begin
if not Assigned(AMethod) then exit; if not Assigned(AMethod) then exit;
DoParallelIntern(AMethod,nil,MTLocalProcNil,StartIndex,EndIndex,Data,MaxThreads); DoParallelIntern(AMethod,nil,nil,StartIndex,EndIndex,Data,MaxThreads);
end; end;
procedure TProcThreadPool.DoParallel(const AProc: TMTProcedure; procedure TProcThreadPool.DoParallel(const AProc: TMTProcedure;
StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt);
begin begin
if not Assigned(AProc) then exit; if not Assigned(AProc) then exit;
DoParallelIntern(nil,AProc,MTLocalProcNil,StartIndex,EndIndex,Data,MaxThreads); DoParallelIntern(nil,AProc,nil,StartIndex,EndIndex,Data,MaxThreads);
end; end;
procedure TProcThreadPool.DoParallelLocalProc(const AProc: Pointer; StartIndex, procedure TProcThreadPool.DoParallelLocalProc(const LocalProc: Pointer;
EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt);
var var
LocalProc: TMTLocalProc; Frame: Pointer;
begin begin
if not Assigned(AProc) then exit; if not Assigned(LocalProc) then exit;
LocalProc.Proc:=AProc; Frame:=get_caller_frame(get_frame);
LocalProc.Frame:=get_caller_frame(get_frame); DoParallelIntern(nil,TMTProcedure(LocalProc),Frame,StartIndex,EndIndex,
DoParallelIntern(nil,nil,LocalProc,StartIndex,EndIndex,Data,MaxThreads); Data,MaxThreads);
end; end;
procedure TProcThreadPool.DoParallelIntern(const AMethod: TMTMethod; procedure TProcThreadPool.DoParallelIntern(const AMethod: TMTMethod;
const AProc: TMTProcedure; const ALocalProc: TMTLocalProc; const AProc: TMTProcedure; const AFrame: Pointer;
StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt);
var var
Group: TProcThreadGroup; Group: TProcThreadGroup;
@@ -699,12 +694,14 @@ begin
try try
for Index:=StartIndex to EndIndex do begin for Index:=StartIndex to EndIndex do begin
Item.FIndex:=Index; Item.FIndex:=Index;
if Assigned(AProc) then if Assigned(AFrame) then begin
AProc(Index,Data,Item) CallLocalProc(AProc,AFrame,Index,Data,Item)
else if Assigned(AMethod) then end else begin
AMethod(Index,Data,Item) if Assigned(AProc) then
else AProc(Index,Data,Item)
CallLocalProc(ALocalProc.Proc,ALocalProc.Frame,Index,Data,Item); else
AMethod(Index,Data,Item)
end;
end; end;
finally finally
Item.Free; Item.Free;
@@ -718,7 +715,7 @@ begin
Group.FTaskData:=Data; Group.FTaskData:=Data;
Group.FTaskMethod:=AMethod; Group.FTaskMethod:=AMethod;
Group.FTaskProcedure:=AProc; Group.FTaskProcedure:=AProc;
Group.FTaskLocalProc:=ALocalProc; Group.FTaskFrame:=AFrame;
Group.FStartIndex:=StartIndex; Group.FStartIndex:=StartIndex;
Group.FEndIndex:=EndIndex; Group.FEndIndex:=EndIndex;
Group.FFirstRunningIndex:=StartIndex; Group.FFirstRunningIndex:=StartIndex;