diff --git a/components/ideintf/ideexterntoolintf.pas b/components/ideintf/ideexterntoolintf.pas index 61239aef92..ae69d3cfdd 100644 --- a/components/ideintf/ideexterntoolintf.pas +++ b/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'') 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. diff --git a/components/lazutils/utf8process.pp b/components/lazutils/utf8process.pp index db19f512aa..328c453031 100644 --- a/components/lazutils/utf8process.pp +++ b/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 } diff --git a/ide/buildmanager.pas b/ide/buildmanager.pas index 7767057c49..4b6e70a380 100644 --- a/ide/buildmanager.pas +++ b/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:=''; diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index 86a61ed18a..d12b70d2ca 100644 --- a/ide/environmentopts.pp +++ b/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', diff --git a/ide/exttools.pas b/ide/exttools.pas index b5deebb216..fbcd0d8334 100644 --- a/ide/exttools.pas +++ b/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; diff --git a/ide/frames/msgwnd_options.lfm b/ide/frames/msgwnd_options.lfm index af5d6a245a..7cb3f09f20 100644 --- a/ide/frames/msgwnd_options.lfm +++ b/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 diff --git a/ide/frames/msgwnd_options.pas b/ide/frames/msgwnd_options.pas index 8984b5ccde..a6c4d47038 100644 --- a/ide/frames/msgwnd_options.pas +++ b/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. diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 373fc91fd7..98d026c9ab 100644 --- a/ide/lazarusidestrconsts.pas +++ b/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'; diff --git a/ide/main.pp b/ide/main.pp index d9d8849d07..5357bf3477 100644 --- a/ide/main.pp +++ b/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]); diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index aeab9e143a..19fb5d8177 100644 --- a/packager/packagesystem.pas +++ b/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);