multithreadproc: added DoParallelNested

git-svn-id: trunk@55024 -

.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

components/multithreadprocs/examples/parallelloop_nested1.lpi

@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InIDEConfig"/>
+      <MainUnit Value="0"/>
+      <Title Value="parallelloop_nested1"/>
+    </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>

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.
+

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;
+      const AProc: TMTProcedure; const ANested: TMTNestedProcedure;
-      StartIndex, EndIndex: PtrInt;
+      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
+  else if Assigned(FTaskProcedure) then
-    if Assigned(FTaskProcedure) then
     FTaskProcedure(Index,Data,Item)
+  else if Assigned(FTaskNested) then
+    FTaskNested(Index,Data,Item)
   else
-      FTaskMethod(Index,Data,Item)
+    FTaskMethod(Index,Data,Item);
-  end;
 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;
+  const AProc: TMTProcedure; const ANested: TMTNestedProcedure;
-  StartIndex, EndIndex: PtrInt; Data: Pointer; MaxThreads: PtrInt);
+  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
+        else if Assigned(AProc) then
-          if Assigned(AProc) then
           AProc(Index,Data,Item)
-          else
+        else if Assigned(AMethod) then
           AMethod(Index,Data,Item)
-        end;
+        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;