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

21
components/multithreadprocs/mtputils.pas
View File

@ -16,6 +16,7 @@
Abstract:
Utility functions using mtprocs.
For example a parallel sort.
}
unit MTPUtils;
@ -27,6 +28,7 @@ uses
Classes, SysUtils, MTProcs;
type
TSortPartEvent = procedure(aList: PPointer; aCount: PtrInt);
{ TParallelSortPointerList }
@ -41,18 +43,23 @@ type
Count: PtrInt;
Compare: TListSortCompare;
BlockCnt: PtrInt;
OnSortPart: TSortPartEvent;
constructor Create(aList: PPointer; aCount: PtrInt; const aCompare: TListSortCompare;
MaxThreadCount: integer = 0);
procedure Sort;
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;
MaxThreadCount: integer = 0);
MaxThreadCount: integer = 0; const OnSortPart: TSortPartEvent = nil);
implementation
procedure ParallelSortFPList(List: TFPList; const Compare: TListSortCompare;
MaxThreadCount: integer = 0);
MaxThreadCount: integer; const OnSortPart: TSortPartEvent);
var
Sorter: TParallelSortPointerList;
begin
@ -60,6 +67,7 @@ begin
Sorter:=TParallelSortPointerList.Create(@List.List[0],List.Count,Compare,
MaxThreadCount);
try
Sorter.OnSortPart:=OnSortPart;
Sorter.Sort;
finally
Sorter.Free;
@ -128,10 +136,13 @@ var
MergeIndex: Integer;
begin
L:=fBlockSize*Index;
R:=L+fBlockSize-1; // middle block
R:=L+fBlockSize-1;
if R>=Count then
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);
if Assigned(OnSortPart) then
OnSortPart(@List[L],R-L+1)
else
MergeSort(L,(L+R+1) div 2,R,true);
// merge
@ -187,7 +198,7 @@ begin
while fBlockCntPowOf2Offset<BlockCnt do
fBlockCntPowOf2Offset:=fBlockCntPowOf2Offset*2;
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);
try
ProcThreadPool.DoParallel(@MTPSort,0,BlockCnt-1);