diff --git a/.gitattributes b/.gitattributes index c7df57ab02..aebd63fe5e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3214,6 +3214,8 @@ components/mrumenu/regmru.res -text components/mrumenu/tmrumenumanager.png -text svneol=unset#image/png components/multithreadprocs/examples/parallelloop1.lpi svneol=native#text/plain components/multithreadprocs/examples/parallelloop1.lpr svneol=native#text/plain +components/multithreadprocs/examples/parallelloop_nested1.lpi svneol=native#text/plain +components/multithreadprocs/examples/parallelloop_nested1.lpr svneol=native#text/plain components/multithreadprocs/examples/recursivemtp1.lpi svneol=native#text/plain components/multithreadprocs/examples/recursivemtp1.lpr svneol=native#text/plain components/multithreadprocs/examples/simplemtp1.lpi svneol=native#text/plain diff --git a/components/multithreadprocs/examples/parallelloop_nested1.lpi b/components/multithreadprocs/examples/parallelloop_nested1.lpi new file mode 100644 index 0000000000..d492e19530 --- /dev/null +++ b/components/multithreadprocs/examples/parallelloop_nested1.lpi @@ -0,0 +1,53 @@ + + + + + + + + + + + + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="MultiThreadProcsLaz"/> + <MinVersion Valid="True"/> + <DefaultFilename Value="../multithreadprocslaz.lpk"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="parallelloop_nested1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + </CompilerOptions> +</CONFIG> diff --git a/components/multithreadprocs/examples/parallelloop_nested1.lpr b/components/multithreadprocs/examples/parallelloop_nested1.lpr new file mode 100644 index 0000000000..07b58b107b --- /dev/null +++ b/components/multithreadprocs/examples/parallelloop_nested1.lpr @@ -0,0 +1,103 @@ +{ Example for a parallel loop with MTProcs. + + Copyright (C) 2017 Mattias Gaertner mattias@freepascal.org + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +program parallelloop_nested1; + +{$mode objfpc}{$H+} +{$ModeSwitch nestedprocvars} + +uses + {$IFDEF UNIX} + cthreads, cmem, + {$ENDIF} + Classes, SysUtils, Math, MTProcs; + + +function FindBestParallel(aList: TList; aValue: Pointer): integer; +var + BlockSize: PtrInt; + Results: array of integer; + + procedure InParallel(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem); + var + i, StartIndex, EndIndex: PtrInt; + begin + Results[Index]:=-1; + StartIndex:=Index*BlockSize; + EndIndex:=Min(StartIndex+BlockSize,aList.Count); + //if MainThreadID=GetCurrentThreadId then + // writeln('FindBestParallel Index=',Index,' StartIndex=',StartIndex,' EndIndex=',EndIndex); + for i:=StartIndex to EndIndex-1 do begin + if aList[i]=aValue then // imagine here an expensive compare function + Results[Index]:=i; + end; + end; + +var + Index: integer; + BlockCount: PtrInt; +begin + ProcThreadPool.CalcBlockSize(aList.Count,BlockCount,BlockSize); + SetLength(Results,BlockCount); + //writeln('FindBestParallel BlockCount=',BlockCount,' List.Count=',aList.Count,' BlockSize=',BlockSize); + ProcThreadPool.DoParallelNested(@InParallel,0,BlockCount-1); + // collect results + Result:=-1; + for Index:=0 to BlockCount-1 do + if Results[Index]>=0 then + Result:=Results[Index]; +end; + +function FindBestSingleThreaded(List: TList; Value: Pointer): integer; +var + i: integer; +begin + Result:=-1; + i:=0; + while i<List.Count do begin + if List[i]=Value then // imagine here an expensive compare function + Result:=i; + inc(i); + end; +end; + +var + List: TList; + i: Integer; +begin + List:=TList.Create; + for i:=0 to 100000000 do + List.Add(Pointer(i)); + writeln('searching ...'); + i:=FindBestParallel(List,Pointer(List.Count-2)); + writeln('parallel search i=',i); + i:=FindBestSingleThreaded(List,Pointer(List.Count-2)); + writeln('linear search i=',i); +end. + diff --git a/components/multithreadprocs/mtprocs.pas b/components/multithreadprocs/mtprocs.pas index 22199d35b7..f9e70d07f0 100644 --- a/components/multithreadprocs/mtprocs.pas +++ b/components/multithreadprocs/mtprocs.pas @@ -20,6 +20,7 @@ unit MTProcs; {$mode objfpc}{$H+} {$inline on} +{$ModeSwitch nestedprocvars} interface @@ -89,6 +90,8 @@ type Item: TMultiThreadProcItem) of object; TMTProcedure = procedure(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem); + TMTNestedProcedure = procedure(Index: PtrInt; Data: Pointer; + Item: TMultiThreadProcItem) is nested; { TProcThreadGroup Each task creates a new group of threads. @@ -119,6 +122,7 @@ type FTaskData: Pointer; FTaskFrame: Pointer; FTaskMethod: TMTMethod; + FTaskNested: TMTNestedProcedure; FTaskProcedure: TMTProcedure; FThreadCount: PtrInt; procedure AddToList(var First: TProcThreadGroup; ListType: TMTPGroupState); inline; @@ -142,6 +146,7 @@ type property LastRunningIndex: PtrInt read FLastRunningIndex; // last started property TaskData: Pointer read FTaskData; property TaskMethod: TMTMethod read FTaskMethod; + property TaskNested: TMTNestedProcedure read FTaskNested; property TaskProcedure: TMTProcedure read FTaskProcedure; property TaskFrame: Pointer read FTaskFrame; property MaxThreads: PtrInt read FMaxThreads; @@ -167,8 +172,8 @@ type procedure SetMaxThreadCount(const AValue: PtrInt); procedure CleanTerminatedThreads; procedure DoParallelIntern(const AMethod: TMTMethod; - const AProc: TMTProcedure; const AFrame: Pointer; - StartIndex, EndIndex: PtrInt; + const AProc: TMTProcedure; const ANested: TMTNestedProcedure; + const AFrame: Pointer; StartIndex, EndIndex: PtrInt; Data: Pointer = nil; MaxThreads: PtrInt = 0); public // for debugging only: the critical section is public: @@ -184,6 +189,9 @@ type procedure DoParallel(const AProc: TMTProcedure; StartIndex, EndIndex: PtrInt; Data: Pointer = nil; MaxThreads: PtrInt = 0); inline; + procedure DoParallelNested(const ANested: TMTNestedProcedure; + StartIndex, EndIndex: PtrInt; + Data: Pointer = nil; MaxThreads: PtrInt = 0); inline; // experimental procedure DoParallelLocalProc(const LocalProc: Pointer; @@ -450,14 +458,14 @@ end; procedure TProcThreadGroup.Run(Index: PtrInt; Data: Pointer; Item: TMultiThreadProcItem); inline; begin - if Assigned(FTaskFrame) then begin + if Assigned(FTaskFrame) then CallLocalProc(FTaskProcedure,FTaskFrame,Index,Data,Item) - end else begin - if Assigned(FTaskProcedure) then - FTaskProcedure(Index,Data,Item) - else - FTaskMethod(Index,Data,Item) - end; + else if Assigned(FTaskProcedure) then + FTaskProcedure(Index,Data,Item) + else if Assigned(FTaskNested) then + FTaskNested(Index,Data,Item) + else + FTaskMethod(Index,Data,Item); end; procedure TProcThreadGroup.IndexComplete(Index: PtrInt); @@ -675,14 +683,21 @@ procedure TProcThreadPool.DoParallel(const AMethod: TMTMethod; StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); begin if not Assigned(AMethod) then exit; - DoParallelIntern(AMethod,nil,nil,StartIndex,EndIndex,Data,MaxThreads); + DoParallelIntern(AMethod,nil,nil,nil,StartIndex,EndIndex,Data,MaxThreads); end; procedure TProcThreadPool.DoParallel(const AProc: TMTProcedure; StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); begin if not Assigned(AProc) then exit; - DoParallelIntern(nil,AProc,nil,StartIndex,EndIndex,Data,MaxThreads); + DoParallelIntern(nil,AProc,nil,nil,StartIndex,EndIndex,Data,MaxThreads); +end; + +procedure TProcThreadPool.DoParallelNested(const ANested: TMTNestedProcedure; + StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); +begin + if not Assigned(ANested) then exit; + DoParallelIntern(nil,nil,ANested,nil,StartIndex,EndIndex,Data,MaxThreads); end; procedure TProcThreadPool.DoParallelLocalProc(const LocalProc: Pointer; @@ -692,7 +707,7 @@ var begin if not Assigned(LocalProc) then exit; Frame:=get_caller_frame(get_frame); - DoParallelIntern(nil,TMTProcedure(LocalProc),Frame,StartIndex,EndIndex, + DoParallelIntern(nil,TMTProcedure(LocalProc),nil,Frame,StartIndex,EndIndex, Data,MaxThreads); end; @@ -713,8 +728,9 @@ begin end; procedure TProcThreadPool.DoParallelIntern(const AMethod: TMTMethod; - const AProc: TMTProcedure; const AFrame: Pointer; - StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt); + const AProc: TMTProcedure; const ANested: TMTNestedProcedure; + const AFrame: Pointer; StartIndex, EndIndex: PtrInt; Data: Pointer; + MaxThreads: PtrInt); var Group: TProcThreadGroup; Index: PtrInt; @@ -734,14 +750,14 @@ begin try for Index:=StartIndex to EndIndex do begin Item.FIndex:=Index; - if Assigned(AFrame) then begin + if Assigned(AFrame) then CallLocalProc(AProc,AFrame,Index,Data,Item) - end else begin - if Assigned(AProc) then - AProc(Index,Data,Item) - else - AMethod(Index,Data,Item) - end; + else if Assigned(AProc) then + AProc(Index,Data,Item) + else if Assigned(AMethod) then + AMethod(Index,Data,Item) + else + ANested(Index,Data,Item); end; finally Item.Free; @@ -755,6 +771,7 @@ begin Group.FTaskData:=Data; Group.FTaskMethod:=AMethod; Group.FTaskProcedure:=AProc; + Group.FTaskNested:=ANested; Group.FTaskFrame:=AFrame; Group.FStartIndex:=StartIndex; Group.FEndIndex:=EndIndex;