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

mtprocs: fixed moving group from need thread list after increasing LastRunningIndex, added CurrentThread variable

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1426 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
mgaertner
2011-01-06 12:01:14 +00:00
parent dcd6bf64fd
commit 0e3e994612
3 changed files with 26 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
components/multithreadprocs/mtprocs.pas
View File

@ -127,6 +127,7 @@ type
procedure AddToList(var First: TProcThreadGroup; ListType: TMTPGroupState); inline;
procedure RemoveFromList(var First: TProcThreadGroup); inline;
function NeedMoreThreads: boolean; inline;
procedure IncreaseLastRunningIndex(Item: TMultiThreadProcItem);
procedure AddThread(AThread: TProcThread);
procedure RemoveThread(AThread: TProcThread); inline;
procedure Run(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem); inline;
@ -203,6 +204,8 @@ type
var
ProcThreadPool: TProcThreadPool = nil;
threadvar
CurrentThread: TThread; // TProcThread sets this, you can set this for your own TThreads descendants
implementation
@ -338,6 +341,7 @@ var
ok: Boolean;
E: Exception;
begin
CurrentThread:=Self;
aPool:=Item.Group.Pool;
ok:=false;
try
@ -353,8 +357,7 @@ begin
// find next work
if Group.LastRunningIndex<Group.EndIndex then begin
// next index of group
inc(Group.FLastRunningIndex);
Item.FIndex:=Group.FLastRunningIndex;
Group.IncreaseLastRunningIndex(Item);
end else begin
// remove from group
RemoveFromList(Group.FFirstThread,mtptlGroup);
@ -422,17 +425,23 @@ begin
and (FState<>mtpgsException);
end;
procedure TProcThreadGroup.IncreaseLastRunningIndex(Item: TMultiThreadProcItem);
begin
inc(FLastRunningIndex);
Item.FIndex:=FLastRunningIndex;
if NeedMoreThreads then exit;
if FState=mtpgsNeedThreads then begin
RemoveFromList(Pool.FFirstGroupNeedThreads);
AddToList(Pool.FFirstGroupFinishing,mtpgsFinishing);
end;
end;
procedure TProcThreadGroup.AddThread(AThread: TProcThread);
begin
AThread.Item.FGroup:=Self;
AThread.AddToList(FFirstThread,mtptlGroup);
inc(FThreadCount);
inc(FLastRunningIndex);
AThread.Item.FIndex:=FLastRunningIndex;
if not NeedMoreThreads then begin
RemoveFromList(Pool.FFirstGroupNeedThreads);
AddToList(Pool.FFirstGroupFinishing,mtpgsFinishing);
end;
IncreaseLastRunningIndex(AThread.Item);
end;
procedure TProcThreadGroup.RemoveThread(AThread: TProcThread);
@ -856,6 +865,7 @@ end;
initialization
ProcThreadPool:=TProcThreadPool.Create;
CurrentThread:=nil;
finalization
ProcThreadPool.Free;

2
components/multithreadprocs/mtputils.pas
View File

@ -35,7 +35,7 @@ type
fBlockSize: PtrInt;
fBlockCntPowOf2Offset: PtrInt;
FMergeBuffer: PPointer;
procedure MTPSort(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem);
procedure MTPSort(Index: PtrInt; {%H-}Data: Pointer; Item: TMultiThreadProcItem);
public
List: PPointer;
Count: PtrInt;

10
components/multithreadprocs/multithreadprocslaz.lpk
View File

@ -2,8 +2,9 @@
<CONFIG>
<Package Version="3">
<Name Value="MultiThreadProcsLaz"/>
<Author Value="Mattias Gaertner mattias@freepascal.org"/>
<CompilerOptions>
<Version Value="8"/>
<Version Value="9"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
@ -11,7 +12,9 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Version Major="1" Release="1"/>
<Description Value="Running procedures and methods parallel via a thread pool."/>
<License Value="modified LGPL2"/>
<Version Major="1" Minor="2" Release="1"/>
<Files Count="3">
<Item1>
<Filename Value="mtprocs.pas"/>
@ -35,11 +38,12 @@
</RequiredPkgs>
<UsageOptions>
<CustomOptions Value="-dUseCThreads"/>
<UnitPath Value="$(PkgOutDir)/"/>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
<Provides Count="2"/>
</Package>
</CONFIG>