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

multithreadprocs: parallelsort: added custom function to sort blocks

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1656 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
mgaertner
2011-05-29 17:41:10 +00:00
parent b4d8b8a10e
commit 5270dd2eb6
1 changed files with 17 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
components/multithreadprocs/mtputils.pas
View File

@ -16,6 +16,7 @@
Abstract: Abstract:
Utility functions using mtprocs. Utility functions using mtprocs.
For example a parallel sort. For example a parallel sort.
} }
unit MTPUtils; unit MTPUtils;
@ -27,6 +28,7 @@ uses
Classes, SysUtils, MTProcs; Classes, SysUtils, MTProcs;
type type
TSortPartEvent = procedure(aList: PPointer; aCount: PtrInt);
{ TParallelSortPointerList } { TParallelSortPointerList }
@ -41,18 +43,23 @@ type
Count: PtrInt; Count: PtrInt;
Compare: TListSortCompare; Compare: TListSortCompare;
BlockCnt: PtrInt; BlockCnt: PtrInt;
OnSortPart: TSortPartEvent;
constructor Create(aList: PPointer; aCount: PtrInt; const aCompare: TListSortCompare; constructor Create(aList: PPointer; aCount: PtrInt; const aCompare: TListSortCompare;
MaxThreadCount: integer = 0); MaxThreadCount: integer = 0);
procedure Sort; procedure Sort;
end; end;
{ Sort a list in parallel using merge sort.
You must provide a compare function.
You can provide your own sort function for the blocks which are sorted in a
single thread, for example a normal quicksort. }
procedure ParallelSortFPList(List: TFPList; const Compare: TListSortCompare; procedure ParallelSortFPList(List: TFPList; const Compare: TListSortCompare;
MaxThreadCount: integer = 0); MaxThreadCount: integer = 0; const OnSortPart: TSortPartEvent = nil);
implementation implementation
procedure ParallelSortFPList(List: TFPList; const Compare: TListSortCompare; procedure ParallelSortFPList(List: TFPList; const Compare: TListSortCompare;
MaxThreadCount: integer = 0); MaxThreadCount: integer; const OnSortPart: TSortPartEvent);
var var
Sorter: TParallelSortPointerList; Sorter: TParallelSortPointerList;
begin begin
@ -60,6 +67,7 @@ begin
Sorter:=TParallelSortPointerList.Create(@List.List[0],List.Count,Compare, Sorter:=TParallelSortPointerList.Create(@List.List[0],List.Count,Compare,
MaxThreadCount); MaxThreadCount);
try try
Sorter.OnSortPart:=OnSortPart;
Sorter.Sort; Sorter.Sort;
finally finally
Sorter.Free; Sorter.Free;
@ -128,11 +136,14 @@ var
MergeIndex: Integer; MergeIndex: Integer;
begin begin
L:=fBlockSize*Index; L:=fBlockSize*Index;
R:=L+fBlockSize-1; // middle block R:=L+fBlockSize-1;
if R>=Count then if R>=Count then
R:=Count-1; // last block R:=Count-1; // last block
WriteLn('TParallelSortPointerList.LWTSort Index=',Index,' sort block: ',L,' ',(L+R+1) div 2,' ',R); //WriteLn('TParallelSortPointerList.LWTSort Index=',Index,' sort block: ',L,' ',(L+R+1) div 2,' ',R);
MergeSort(L,(L+R+1) div 2,R,true); if Assigned(OnSortPart) then
OnSortPart(@List[L],R-L+1)
else
MergeSort(L,(L+R+1) div 2,R,true);
// merge // merge
// 0 1 2 3 4 5 6 7 // 0 1 2 3 4 5 6 7
@ -187,7 +198,7 @@ begin
while fBlockCntPowOf2Offset<BlockCnt do while fBlockCntPowOf2Offset<BlockCnt do
fBlockCntPowOf2Offset:=fBlockCntPowOf2Offset*2; fBlockCntPowOf2Offset:=fBlockCntPowOf2Offset*2;
fBlockCntPowOf2Offset:=fBlockCntPowOf2Offset-BlockCnt; fBlockCntPowOf2Offset:=fBlockCntPowOf2Offset-BlockCnt;
WriteLn('TParallelSortPointerList.Sort BlockCnt=',BlockCnt,' fBlockSize=',fBlockSize,' fBlockCntPowOf2Offset=',fBlockCntPowOf2Offset); //WriteLn('TParallelSortPointerList.Sort BlockCnt=',BlockCnt,' fBlockSize=',fBlockSize,' fBlockCntPowOf2Offset=',fBlockCntPowOf2Offset);
GetMem(FMergeBuffer,SizeOf(Pointer)*Count); GetMem(FMergeBuffer,SizeOf(Pointer)*Count);
try try
ProcThreadPool.DoParallel(@MTPSort,0,BlockCnt-1); ProcThreadPool.DoParallel(@MTPSort,0,BlockCnt-1);