IDE: enabled group compile

git-svn-id: trunk@45987 -

components/ideintf/ideexterntoolintf.pas

@@ -14,7 +14,7 @@ unit IDEExternToolIntf;
 interface
 
 uses
-  Classes, SysUtils, typinfo, UTF8Process, AvgLvlTree,
+  Classes, SysUtils, Math, TypInfo, UTF8Process, AvgLvlTree,
   ObjInspStrConsts, LazLogger, LazFileUtils, LazFileCache, Menus, LCLProc;
 
 const
@@ -272,7 +272,7 @@ type
   { TExtToolParser
     Read the output of a tool, for example the output of the Free Pascal compiler.
     It does not filter. Some parsers can work together, for example make and fpc.
-    Usage: Tool.AddParsers('fpc');
+    Usage: Tool.AddParsers('ParserName');
     }
   TExtToolParser = class(TComponent)
   private
@@ -349,7 +349,11 @@ type
 const
   DefaultETViewMinUrgency = mluHint;
 type
-  { TExtToolView }
+  { TExtToolView
+    Implemented by the IDE.
+    When a tool with a scanner but no View is started the IDE automatically
+    creates a View.
+    You can create a View with IDEMessagesWindow.CreateView(Title) }
 
   TExtToolView = class(TComponent)
   private
@@ -429,7 +433,9 @@ type
   TExternalToolGroup = class;
 
   { TAbstractExternalTool
-    access needs Tool.Enter/LeaveCriticalSection }
+    Implemented by the IDE.
+    Create one with ExternalToolList.Add or AddDummy.
+    Access needs Tool.Enter/LeaveCriticalSection. }
 
   TAbstractExternalTool = class(TComponent)
   private
@@ -563,11 +569,13 @@ type
   end;
 
   { TExternalToolGroup
-    Hint: Add tools by setting Tool.Group:=Group }
+    Hint: Add tools by setting Tool.Group:=Group.
+    You can create your own descendant classes. }
 
   TExternalToolGroup = class(TComponent)
   private
     FAbortIfOneFails: boolean;
+    FErrorMessage: string;
     FItems: TFPList; // list of TAbstractExternalTool
     function GetItems(Index: integer): TAbstractExternalTool;
     procedure InternalRemove(Tool: TAbstractExternalTool); virtual;
@@ -578,12 +586,17 @@ type
     procedure Clear; virtual;
     function Count: integer;
     procedure Execute; virtual;
+    procedure WaitForExit; virtual;
+    procedure Terminate; virtual;
+    function AllStopped: boolean;
     property Items[Index: integer]: TAbstractExternalTool read GetItems; default;
     property AbortIfOneFails: boolean read FAbortIfOneFails write FAbortIfOneFails;
     procedure ToolExited(Tool: TAbstractExternalTool); virtual;
+    property ErrorMessage: string read FErrorMessage write FErrorMessage;
   end;
 
-  { TIDEExternalTools }
+  { TIDEExternalTools
+    Implemented by the IDE. }
 
   TIDEExternalTools = class(TComponent)
   private
@@ -605,6 +618,7 @@ type
     procedure EnterCriticalSection; virtual; abstract;
     procedure LeaveCriticalSection; virtual; abstract;
     function GetIDEObject(ToolData: TIDEExternalToolData): TObject; virtual; abstract;
+    procedure HandleMesages; virtual; abstract;
     // parsers
     procedure RegisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread)
     procedure UnregisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread)
@@ -663,6 +677,7 @@ type
 
 var
   RunExternalTool: TRunExternalTool = nil;// set by the IDE
+  DefaultMaxProcessCount: integer = 2;// set by the IDE
 
 function CompareMsgLinesSrcPos(MsgLine1, MsgLine2: Pointer): integer;
 
@@ -867,11 +882,41 @@ begin
   for i:=0 to Count-1 do begin
     Tool:=Items[i];
     if Tool.Terminated then continue;
-    debugln(['TExternalToolGroup.Execute ',Tool.Title]);
+    //debugln(['TExternalToolGroup.Execute ',Tool.Title]);
     Tool.Execute;
   end;
 end;
 
+procedure TExternalToolGroup.WaitForExit;
+begin
+  repeat
+    ExternalToolList.HandleMesages;
+    if AllStopped then exit;
+    Sleep(20);
+    //debugln(['TExternalToolGroup.WaitForExit ',Now,'==========================']);
+    //for i:=0 to Count-1 do
+    //  debugln(['  Stage=',dbgs(Items[i].Stage),' "',Items[i].Title,'"']);
+  until false;
+end;
+
+procedure TExternalToolGroup.Terminate;
+var
+  i: Integer;
+begin
+  for i:=Count-1 downto 0 do
+    if i<Count then
+      Items[i].Terminate;
+end;
+
+function TExternalToolGroup.AllStopped: boolean;
+var
+  i: Integer;
+begin
+  for i:=0 to Count-1 do
+    if ord(Items[i].Stage)<ord(etsStopped) then exit(false);
+  Result:=true;
+end;
+
 procedure TExternalToolGroup.InternalRemove(Tool: TAbstractExternalTool);
 begin
   FItems.Remove(Tool);
@@ -888,13 +933,13 @@ begin
 end;
 
 procedure TExternalToolGroup.ToolExited(Tool: TAbstractExternalTool);
-var
-  i: Integer;
 begin
   //debugln(['TExternalToolGroup.ToolExited START ',Tool.Title,' Error=',Tool.ErrorMessage,' AbortIfOneFails=',AbortIfOneFails]);
-  if (Tool.ErrorMessage<>'') and AbortIfOneFails then begin
-    for i:=Count-1 downto 0 do
-      Items[i].Terminate;
+  if (Tool.ErrorMessage<>'') then begin
+    if ErrorMessage='' then
+      ErrorMessage:=Tool.ErrorMessage;
+    if AbortIfOneFails then
+      Terminate;
   end;
 end;
 
@@ -2365,5 +2410,10 @@ begin
   end;
 end;
 
+initialization
+  // on single cores there is delay due to file reads
+  // => use 2 processes in parallel by default
+  DefaultMaxProcessCount:=Max(2,GetSystemThreadCount);
+
 end.
 

components/lazutils/utf8process.pp

@@ -64,10 +64,77 @@ type
 procedure RunCmdFromPath(ProgramFilename, CmdLineParameters: string);
 function FindFilenameOfCmd(ProgramFilename: string): string;
 
+function GetSystemThreadCount: integer; // guess number of cores
+
 procedure Register;
 
 implementation
 
+{$IF defined(windows)}
+uses Windows;
+{$ELSEIF defined(freebsd) or defined(darwin)}
+uses ctypes, sysctl;
+{$ELSEIF defined(linux)}
+{$linklib c}
+uses ctypes;
+{$ENDIF}
+
+{$IFDEF Linux}
+const _SC_NPROCESSORS_ONLN = 83;
+function sysconf(i: cint): clong; cdecl; external name 'sysconf';
+{$ENDIF}
+
+function GetSystemThreadCount: integer;
+// returns a good default for the number of threads on this system
+{$IF defined(windows)}
+//returns total number of processors available to system including logical hyperthreaded processors
+var
+  i: Integer;
+  ProcessAffinityMask, SystemAffinityMask: DWORD_PTR;
+  Mask: DWORD;
+  SystemInfo: SYSTEM_INFO;
+begin
+  if GetProcessAffinityMask(GetCurrentProcess, ProcessAffinityMask, SystemAffinityMask)
+  then begin
+    Result := 0;
+    for i := 0 to 31 do begin
+      Mask := DWord(1) shl i;
+      if (ProcessAffinityMask and Mask)<>0 then
+        inc(Result);
+    end;
+  end else begin
+    //can't get the affinity mask so we just report the total number of processors
+    GetSystemInfo(SystemInfo);
+    Result := SystemInfo.dwNumberOfProcessors;
+  end;
+end;
+{$ELSEIF defined(UNTESTEDsolaris)}
+  begin
+    t = sysconf(_SC_NPROC_ONLN);
+  end;
+{$ELSEIF defined(freebsd) or defined(darwin)}
+var
+  mib: array[0..1] of cint;
+  len: cint;
+  t: cint;
+begin
+  mib[0] := CTL_HW;
+  mib[1] := HW_NCPU;
+  len := sizeof(t);
+  fpsysctl(pchar(@mib), 2, @t, @len, Nil, 0);
+  Result:=t;
+end;
+{$ELSEIF defined(linux)}
+  begin
+    Result:=sysconf(_SC_NPROCESSORS_ONLN);
+  end;
+
+{$ELSE}
+  begin
+    Result:=1;
+  end;
+{$ENDIF}
+
 {$WARN SYMBOL_DEPRECATED OFF}
 
 { TProcessUTF8 }

ide/buildmanager.pas

@@ -171,6 +171,7 @@ type
     procedure SetupExternalTools;
     procedure SetupCompilerInterface;
     procedure SetupInputHistories;
+    procedure EnvOptsChanged;
 
     function GetBuildMacroOverride(const MacroName: string): string; override;
     function GetBuildMacroOverrides: TStrings; override;
@@ -516,6 +517,14 @@ begin
   end;
 end;
 
+procedure TBuildManager.EnvOptsChanged;
+begin
+  if EnvironmentOptions.MaxExtToolsInParallel<=0 then
+    ExternalTools.MaxProcessCount:=DefaultMaxProcessCount
+  else
+    ExternalTools.MaxProcessCount:=EnvironmentOptions.MaxExtToolsInParallel;
+end;
+
 function TBuildManager.GetBuildMacroOverride(const MacroName: string): string;
 begin
   Result:='';

ide/environmentopts.pp

@@ -254,6 +254,7 @@ type
     FFilename: string;
     FFileAge: longint;
     FFileHasChangedOnDisk: boolean;
+    FMaxExtToolsInParallel: integer;
     FOldLazarusVersion: string;
     FXMLCfg: TRttiXMLConfig;
     FConfigStore: TXMLOptionsStorage;
@@ -688,6 +689,8 @@ type
        
     // external tools
     property ExternalToolMenuItems: TBaseExternalUserTools read fExternalUserTools;
+    property MaxExtToolsInParallel: integer read FMaxExtToolsInParallel
+                                            write FMaxExtToolsInParallel; // 0=automatic
 
     // naming conventions
     property PascalFileExtension: TPascalExtType read fPascalFileExtension
@@ -987,6 +990,7 @@ begin
   
   // external tools
   fExternalUserTools:=ExternalUserToolsClass.Create;
+  FMaxExtToolsInParallel:=0;
 
   // naming
   fPascalFileExtension:=petPAS;
@@ -1431,6 +1435,7 @@ begin
 
       // external tools
       fExternalUserTools.Load(FConfigStore,Path+'ExternalTools/');
+      FMaxExtToolsInParallel:=XMLConfig.GetValue(Path+'ExternalTools/MaxInParallel',0);
 
       // naming
       LoadPascalFileExt(Path+'');
@@ -1804,6 +1809,8 @@ begin
 
       // external tools
       fExternalUserTools.Save(FConfigStore,Path+'ExternalTools/');
+      XMLConfig.SetDeleteValue(Path+'ExternalTools/MaxInParallel',
+                               FMaxExtToolsInParallel,0);
 
       // naming
       XMLConfig.SetDeleteValue(Path+'Naming/PascalFileExtension',

ide/exttools.pas

@@ -41,10 +41,10 @@ uses
   // LCL
   LCLIntf, LCLProc, Forms, Dialogs, FileUtil, AvgLvlTree,
   // IDEIntf
-  IDEExternToolIntf, BaseIDEIntf, MacroIntf, IDEMsgIntf,
+  IDEExternToolIntf, BaseIDEIntf, MacroIntf, IDEMsgIntf, IDEDialogs,
+  CompOptsIntf, PackageIntf, LazIDEIntf,
   // IDE
-  IDEDialogs, CompOptsIntf, PackageIntf, LazIDEIntf, TransferMacros,
-  LazarusIDEStrConsts;
+  TransferMacros, LazarusIDEStrConsts;
 
 type
   TLMVToolState = (
@@ -193,6 +193,7 @@ type
     procedure EnterCriticalSection; override;
     procedure LeaveCriticalSection; override;
     function GetIDEObject(ToolData: TIDEExternalToolData): TObject; override;
+    procedure HandleMesages; override;
     // parsers
     function ParserCount: integer; override;
     procedure RegisterParser(Parser: TExtToolParserClass); override;
@@ -869,7 +870,7 @@ end;
 
 procedure TExternalTool.AddExecuteBefore(Tool: TAbstractExternalTool);
 begin
-  debugln(['TExternalTool.AddExecuteBefore Self=',Title,' Tool=',Tool.Title]);
+  //debugln(['TExternalTool.AddExecuteBefore Self=',Title,' Tool=',Tool.Title]);
   if (Tool=Self) or (Tool.IsExecutedBefore(Self)) then
     raise Exception.Create('TExternalTool.AddExecuteBefore: that would create a circle');
   if (fExecuteBefore<>nil) and (fExecuteBefore.IndexOf(Tool)<0) then
@@ -1261,8 +1262,7 @@ begin
   InitCriticalSection(FCritSec);
   fRunning:=TFPList.Create;
   fParsers:=TFPList.Create;
-  MaxProcessCount:=2; // even on single cores there is delay due to file reads
-                      // => use 2 processes in parallel by default
+  MaxProcessCount:=2;
   if ExternalToolList=nil then
     ExternalToolList:=Self;
   if ExternalTools=nil then
@@ -1389,6 +1389,11 @@ begin
   end;
 end;
 
+procedure TExternalTools.HandleMesages;
+begin
+  Application.ProcessMessages;
+end;
+
 procedure TExternalTools.RegisterParser(Parser: TExtToolParserClass);
 begin
   if fParsers.IndexOf(Parser)>=0 then exit;

ide/frames/msgwnd_options.lfm

@@ -188,4 +188,28 @@ object MsgWndOptionsFrame: TMsgWndOptionsFrame
     ShowHint = True
     TabOrder = 4
   end
+  object MWMaxProcsSpinEdit: TSpinEdit
+    AnchorSideLeft.Control = MWMaxProcsLabel
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = MWFocusCheckBox
+    AnchorSideTop.Side = asrBottom
+    Left = 110
+    Height = 25
+    Top = 295
+    Width = 50
+    BorderSpacing.Left = 2
+    TabOrder = 5
+  end
+  object MWMaxProcsLabel: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = MWMaxProcsSpinEdit
+    AnchorSideTop.Side = asrCenter
+    Left = 6
+    Height = 15
+    Top = 300
+    Width = 102
+    BorderSpacing.Left = 6
+    Caption = 'MWMaxProcsLabel'
+    ParentColor = False
+  end
 end

ide/frames/msgwnd_options.pas

@@ -30,8 +30,9 @@ unit MsgWnd_Options;
 interface
 
 uses
-  Classes, SysUtils, FileUtil, LazLoggerBase, IDEOptionsIntf, SynEdit, Forms,
-  Controls, Graphics, Dialogs, StdCtrls, ColorBox, ExtCtrls,
+  Classes, SysUtils, FileUtil, LazLoggerBase, SynEdit, Forms,
+  Controls, Graphics, Dialogs, StdCtrls, ColorBox, ExtCtrls, Spin,
+  IDEOptionsIntf, IDEExternToolIntf,
   LazarusIDEStrConsts, EnvironmentOpts, editor_general_options, EditorOptions;
 
 type
@@ -43,6 +44,8 @@ type
     MWDblClickJumpsCheckBox: TCheckBox;
     MWFocusCheckBox: TCheckBox;
     MWHideIconsCheckBox: TCheckBox;
+    MWMaxProcsLabel: TLabel;
+    MWMaxProcsSpinEdit: TSpinEdit;
     MWOptsLeftBevel: TBevel;
     MWColorBox: TColorBox;
     MWColorListBox: TColorListBox;
@@ -155,6 +158,8 @@ begin
     lisDrawTheSelectionFocusedEvenIfTheMessagesWindowHasN;
   MWDblClickJumpsCheckBox.Caption:=lisEnvJumpFromMessageToSrcOnDblClickOtherwiseSingleClick;
   MWFocusCheckBox.Caption:=dlgEOFocusMessagesAfterCompilation;
+  MWMaxProcsLabel.Caption:=Format(lisMaximumParallelProcesses0MeansDefault, [
+    IntToStr(DefaultMaxProcessCount)]);
 end;
 
 function TMsgWndOptionsFrame.GetTitle: String;
@@ -181,6 +186,7 @@ begin
   MWAlwaysDrawFocusedCheckBox.Checked := o.MsgViewAlwaysDrawFocused;
   MWDblClickJumpsCheckBox.Checked:=o.MsgViewDblClickJumps;
   MWFocusCheckBox.Checked:=o.MsgViewFocus;
+  MWMaxProcsSpinEdit.Value:=o.MaxExtToolsInParallel;
 
   fReady:=true;
 end;
@@ -197,6 +203,7 @@ begin
   o.MsgViewAlwaysDrawFocused := MWAlwaysDrawFocusedCheckBox.Checked;
   o.MsgViewDblClickJumps := MWDblClickJumpsCheckBox.Checked;
   o.MsgViewFocus := MWFocusCheckBox.Checked;
+  o.MaxExtToolsInParallel := MWMaxProcsSpinEdit.Value;
 end;
 
 class function TMsgWndOptionsFrame.

ide/lazarusidestrconsts.pas

@@ -1109,6 +1109,8 @@ resourcestring
   dlgIDEOptions = 'IDE Options';
   dlgBakNoSubDirectory = '(no subdirectory)';
   dlgEOFocusMessagesAfterCompilation = 'Focus messages after compilation';
+  lisMaximumParallelProcesses0MeansDefault = 'Maximum parallel processes, 0 '
+    +'means default (%s)';
   lisMessagesWindow = 'Messages Window';
   lisCheckForDiskFileChangesViaContentRatherThanTimesta = 'Check for disk file'
     +' changes via content rather than timestamp';

ide/main.pp

@@ -1447,6 +1447,7 @@ begin
   {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Create CODETOOLS');{$ENDIF}
 
   MainBuildBoss.SetupExternalTools;
+  MainBuildBoss.EnvOptsChanged;
 
   // build and position the MainIDE form
   Application.CreateForm(TMainIDEBar,MainIDEBar);
@@ -4841,6 +4842,7 @@ begin
   LazarusSrcDirChanged:=false;
   ChangeMacroValue('LazarusDir',EnvironmentOptions.GetParsedLazarusDirectory);
   ChangeMacroValue('FPCSrcDir',EnvironmentOptions.GetParsedFPCSourceDirectory);
+  MainBuildBoss.EnvOptsChanged;
 
   if MacroValueChanged then CodeToolBoss.DefineTree.ClearCache;
   //debugln(['TMainIDE.DoEnvironmentOptionsAfterWrite FPCCompilerChanged=',FPCCompilerChanged,' FPCSrcDirChanged=',FPCSrcDirChanged,' LazarusSrcDirChanged=',LazarusSrcDirChanged]);

packager/packagesystem.pas

@@ -3308,7 +3308,7 @@ begin
   end;
 
   if GroupCompile and (lpfNeedGroupCompile in APackage.Flags) then begin
-    debugln(['TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile dependencies will be rebuilt']);
+    //debugln(['TLazPackageGraph.CheckIfCurPkgOutDirNeedsCompile dependencies will be rebuilt']);
     Note+='Dependencies will be rebuilt';
     DependenciesChanged:=true;
     exit(mrYes);
@@ -3554,9 +3554,8 @@ var
   CurPkg: TLazPackage;
   BuildItem: TLazPkgGraphBuildItem;
   j: Integer;
+  {$IFDEF DisableGroupCompile}
   Tool: TAbstractExternalTool;
-  {$IFDEF EnableGroupCompile}
-  ToolData: TLazPkgGraphExtToolData;
   {$ENDIF}
   aDependency: TPkgDependency;
   RequiredBuildItem: TLazPkgGraphBuildItem;
@@ -3600,12 +3599,12 @@ begin
       BuildItems:=TObjectList.Create(true);
       for i:=0 to PkgList.Count-1 do begin
         CurPkg:=TLazPackage(PkgList[i]);
-        {$IFDEF EnableGroupCompile}
+        {$IFDEF DisableGroupCompile}
+        BuildItem:=nil;
+        {$ELSE}
         BuildItem:=TLazPkgGraphBuildItem.Create(nil);
         BuildItem.LazPackage:=CurPkg;
         BuildItems.Add(BuildItem);
-        {$ELSE}
-        BuildItem:=nil;
         {$ENDIF}
         Result:=CompilePackage(CurPkg,Flags,false,BuildItem);
         if Result<>mrOk then exit;
@@ -3651,11 +3650,10 @@ begin
         end;
       end;
 
+      if ToolGroup=nil then exit(mrOk);
+
       // execute
-      {$IFDEF EnableGroupCompile}
-      ToolGroup.Execute;
-      ToolGroup.WaitForExit;
-      {$ELSE}
+      {$IFDEF DisableGroupCompile}
       for i:=0 to BuildItems.Count-1 do begin
         BuildItem:=TLazPkgGraphBuildItem(BuildItems[i]);
         for j:=0 to BuildItem.Count-1 do begin
@@ -3668,6 +3666,13 @@ begin
             exit(mrCancel);
         end;
       end;
+      {$ELSE}
+      ToolGroup.Execute;
+      ToolGroup.WaitForExit;
+      if ToolGroup.ErrorMessage<>'' then begin
+        debugln(['TLazPackageGraph.CompileRequiredPackages ERROR="',ToolGroup.ErrorMessage,'"']);
+        exit(mrCancel);
+      end;
       {$ENDIF}
     finally
       FreeAndNil(ToolGroup);