From 2d8cf332f966e7dba3ea05774240b7a788545121 Mon Sep 17 00:00:00 2001 From: martin Date: Sat, 22 Aug 2020 20:27:17 +0000 Subject: [PATCH] FpDebug: Run some tasks in threads during startup git-svn-id: trunk@63812 - --- components/fpdebug/fpdbgdwarfdataclasses.pas | 137 ++++++- components/fpdebug/fpdbgutil.pp | 375 ++++++++++++++++++- 2 files changed, 492 insertions(+), 20 deletions(-) diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index 2b694fd412..16daa6229e 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -42,9 +42,8 @@ interface uses Classes, Types, SysUtils, FpDbgUtil, FpDbgInfo, FpDbgDwarfConst, Maps, Math, - FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages, - LazLoggerBase, LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes, - FpDbgCommon; + FpDbgLoader, FpImgReaderBase, FpdMemoryTools, FpErrorMessages, LazLoggerBase, + LazClasses, LazFileUtils, LazUTF8, contnrs, DbgIntfBaseTypes; type TDwarfSection = (dsAbbrev, dsARanges, dsFrame, dsInfo, dsLine, dsLoc, dsMacinfo, dsPubNames, dsPubTypes, dsRanges, dsStr); @@ -535,6 +534,29 @@ type end; PDwarfDebugFile = ^TDwarfDebugFile; + { TFpThreadWorkerComputeNameHashes } + + TFpThreadWorkerComputeNameHashes = class(TFpThreadWorkerItem) + protected + FCU: TDwarfCompilationUnit; + FReadyToRun: Cardinal; + procedure DoExecute; override; + public + constructor Create(CU: TDwarfCompilationUnit); + procedure MarkReadyToRun; // will queue to run on the 2nd call + end; + + { TFpThreadWorkerScanAll } + + TFpThreadWorkerScanAll = class(TFpThreadWorkerItem) + protected + FCU: TDwarfCompilationUnit; + FCompNameHashWorker: TFpThreadWorkerComputeNameHashes; + procedure DoExecute; override; + public + constructor Create(CU: TDwarfCompilationUnit; ACompNameHashWorker: TFpThreadWorkerComputeNameHashes); + end; + { TDwarfCompilationUnit } TDwarfCompilationUnitClass = class of TDwarfCompilationUnit; @@ -592,9 +614,11 @@ type FMaxPC: QWord; // FScope: TDwarfScopeInfo; FScopeList: TDwarfScopeList; - FScannedToEnd: Boolean; FKnownNameHashes: TKnownNameHashesArray; + FScanAllWorker: TFpThreadWorkerScanAll; + FComputeNameHashesWorker: TFpThreadWorkerComputeNameHashes; + procedure BuildAddressMap; function GetAddressMap: TMap; function GetKnownNameHashes: PKnownNameHashesArray; inline; @@ -621,7 +645,8 @@ type public constructor Create(AOwner: TFpDwarfInfo; ADebugFile: PDwarfDebugFile; ADataOffset: QWord; ALength: QWord; AVersion: Word; AAbbrevOffset: QWord; AAddressSize: Byte; AIsDwarf64: Boolean); virtual; destructor Destroy; override; - procedure ScanAllEntries; inline; + procedure WaitForScopeScan; inline; // MUST be called, before accessing the CU + procedure WaitForComputeHashes; inline; function GetDefinition(AAbbrevPtr: Pointer; out ADefinition: TDwarfAbbrev): Boolean; inline; function GetLineAddressMap(const AFileName: String): PDWarfLineMap; function GetLineAddresses(const AFileName: String; ALine: Cardinal; var AResultList: TDBGPtrArray): boolean; @@ -667,6 +692,7 @@ type TFpDwarfInfo = class(TDbgInfo) private + FWorkQueue: TFpGlobalThreadWorkerQueue; FCompilationUnits: TList; FImageBase: QWord; FFiles: array of TDwarfDebugFile; @@ -690,6 +716,7 @@ type property CompilationUnits[AIndex: Integer]: TDwarfCompilationUnit read GetCompilationUnit; property ImageBase: QWord read FImageBase; + property WorkQueue: TFpGlobalThreadWorkerQueue read FWorkQueue; end; TDwarfLocationExpression = class; @@ -3306,6 +3333,9 @@ var p: PDbgImageSection; i: Integer; begin + FWorkQueue := FpDbgGlobalWorkerQueue; + FWorkQueue.AddRef; + inherited Create(ALoaderList, AMemManager); FTargetInfo := ALoaderList.TargetInfo; FCompilationUnits := TList.Create; @@ -3332,9 +3362,11 @@ destructor TFpDwarfInfo.Destroy; var n: integer; begin + FWorkQueue.DecRef; for n := 0 to FCompilationUnits.Count - 1 do TObject(FCompilationUnits[n]).Free; FreeAndNil(FCompilationUnits); + inherited Destroy; end; @@ -3366,6 +3398,7 @@ end; function TFpDwarfInfo.GetCompilationUnit(AIndex: Integer): TDwarfCompilationUnit; begin Result := TDwarfCompilationUnit(FCompilationUnits[Aindex]); + Result.WaitForScopeScan; end; function TFpDwarfInfo.GetCompilationUnitClass: TDwarfCompilationUnitClass; @@ -3392,7 +3425,9 @@ begin Result := TDwarfCompilationUnit(FCompilationUnits[h]); if (p < Result.FInfoData) or (p > Result.FInfoData + Result.FLength) then - Result := nil; + Result := nil + else + Result.WaitForScopeScan; end; function TFpDwarfInfo.FindDwarfProcSymbol(AAddress: TDbgPtr @@ -3413,6 +3448,7 @@ begin for n := 0 to FCompilationUnits.Count - 1 do begin CU := TDwarfCompilationUnit(FCompilationUnits[n]); + CU.WaitForScopeScan; if not CU.Valid then Continue; MinMaxSet := CU.FMinPC <> CU.FMaxPC; if MinMaxSet and ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC)) @@ -3458,6 +3494,7 @@ begin for n := 0 to FCompilationUnits.Count - 1 do begin CU := TDwarfCompilationUnit(FCompilationUnits[n]); + CU.WaitForScopeScan; if not CU.Valid then Continue; MinMaxSet := CU.FMinPC <> CU.FMaxPC; if (not MinMaxSet) or ((AAddress < CU.FMinPC) or (AAddress > CU.FMaxPC)) @@ -3481,6 +3518,7 @@ begin for n := 0 to FCompilationUnits.Count - 1 do begin CU := TDwarfCompilationUnit(FCompilationUnits[n]); + CU.WaitForScopeScan; Result := CU.GetLineAddresses(AFileName, ALine, AResultList) or Result; end; end; @@ -3494,6 +3532,7 @@ begin for n := 0 to FCompilationUnits.Count - 1 do begin CU := TDwarfCompilationUnit(FCompilationUnits[n]); + CU.WaitForScopeScan; Result := CU.GetLineAddressMap(AFileName); if Result <> nil then Exit; end; @@ -3551,6 +3590,9 @@ begin end; end; Result := FCompilationUnits.Count; + + for i := 0 to Result - 1 do + TDwarfCompilationUnit(FCompilationUnits[i]).FComputeNameHashesWorker.MarkReadyToRun; end; function TFpDwarfInfo.PointerFromRVA(ARVA: QWord): Pointer; @@ -3832,6 +3874,49 @@ begin FDefaultMap := AMap; end; +{ TFpThreadWorkerScanAll } + +procedure TFpThreadWorkerScanAll.DoExecute; +var + ResultScope: TDwarfScopeInfo; +begin + FCU.LocateEntry(0, ResultScope); + FCompNameHashWorker.MarkReadyToRun; +end; + +constructor TFpThreadWorkerScanAll.Create(CU: TDwarfCompilationUnit; + ACompNameHashWorker: TFpThreadWorkerComputeNameHashes); +begin + FCU := CU; + FCompNameHashWorker := ACompNameHashWorker; +end; + +{ TFpThreadWorkerComputeNameHashes } + +procedure TFpThreadWorkerComputeNameHashes.DoExecute; +var + InfoEntry: TDwarfInformationEntry; +begin + InfoEntry := TDwarfInformationEntry.Create(FCU, nil); + InfoEntry.ScopeIndex := FCU.FirstScope.Index; + InfoEntry.ComputeKnownHashes(@FCU.FKnownNameHashes); + InfoEntry.ReleaseReference; +end; + +constructor TFpThreadWorkerComputeNameHashes.Create(CU: TDwarfCompilationUnit); +begin + FCU := CU; +end; + +procedure TFpThreadWorkerComputeNameHashes.MarkReadyToRun; +var + c: Cardinal; +begin + c := InterLockedIncrement(FReadyToRun); + if c = 2 then + FCU.FOwner.WorkQueue.PushItem(Self); +end; + { TDwarfCompilationUnit } procedure TDwarfCompilationUnit.BuildLineInfo(AAddressInfo: PDwarfAddressInfo; ADoAll: Boolean); @@ -3920,6 +4005,7 @@ end; function TDwarfCompilationUnit.GetKnownNameHashes: PKnownNameHashesArray; begin + WaitForComputeHashes; Result := @FKnownNameHashes; end; @@ -3944,14 +4030,22 @@ begin Result := FAbbrevList.FindLe128bFromPointer(AAbbrevPtr, ADefinition) <> nil; end; -procedure TDwarfCompilationUnit.ScanAllEntries; -var - ResultScope: TDwarfScopeInfo; +procedure TDwarfCompilationUnit.WaitForScopeScan; begin - if FScannedToEnd then exit; - FScannedToEnd := True; - // scan to end - LocateEntry(0, ResultScope); + if FScanAllWorker <> nil then begin + FOwner.WorkQueue.WaitForItem(FScanAllWorker); + FScanAllWorker.DecRef; + end; + FScanAllWorker := nil; +end; + +procedure TDwarfCompilationUnit.WaitForComputeHashes; +begin + if FComputeNameHashesWorker <> nil then begin + FOwner.WorkQueue.WaitForItem(FComputeNameHashesWorker); + FComputeNameHashesWorker.DecRef; + end; + FComputeNameHashesWorker := nil; end; procedure TDwarfCompilationUnit.BuildAddressMap; @@ -4109,7 +4203,6 @@ var Form: Cardinal; StatementListOffs, Offs: QWord; Scope: TDwarfScopeInfo; - InfoEntry: TDwarfInformationEntry; begin //DebugLn(FPDBG_DWARF_VERBOSE, ['-- compilation unit --']); //DebugLn(FPDBG_DWARF_VERBOSE, [' data offset: ', ADataOffset]); @@ -4164,11 +4257,12 @@ begin end; FValid := True; - ScanAllEntries; - InfoEntry := TDwarfInformationEntry.Create(Self, nil); - InfoEntry.ScopeIndex := FirstScope.Index; - InfoEntry.ComputeKnownHashes(@FKnownNameHashes); - InfoEntry.ReleaseReference; + FComputeNameHashesWorker := TFpThreadWorkerComputeNameHashes.Create(Self); + FComputeNameHashesWorker.AddRef; + + FScanAllWorker := TFpThreadWorkerScanAll.Create(Self, FComputeNameHashesWorker); + FScanAllWorker.AddRef; + FOwner.WorkQueue.PushItem(FScanAllWorker); AttribList.EvalCount := 0; /// TODO: (dafHasName in Abbrev.flags) @@ -4227,6 +4321,11 @@ destructor TDwarfCompilationUnit.Destroy; end; begin + FOwner.WorkQueue.RemoveItem(FComputeNameHashesWorker); + FOwner.WorkQueue.RemoveItem(FScanAllWorker); + FComputeNameHashesWorker.DecRef; + FScanAllWorker.DecRef; + FreeAndNil(FAbbrevList); FreeAndNil(FAddressMap); FreeLineNumberMap; diff --git a/components/fpdebug/fpdbgutil.pp b/components/fpdebug/fpdbgutil.pp index 3688c2424e..f72084e192 100644 --- a/components/fpdebug/fpdbgutil.pp +++ b/components/fpdebug/fpdbgutil.pp @@ -38,12 +38,93 @@ unit FpDbgUtil; interface uses - Classes, SysUtils, LazUTF8; + Classes, SysUtils, fgl, math, LazUTF8, lazCollections, LazClasses, + UTF8Process, syncobjs; type THexValueFormatFlag = (hvfSigned, hvfPrefixPositive, hvfIncludeHexchar); THexValueFormatFlags = set of THexValueFormatFlag; + TFpThreadWorkerQueue = class; + TFpWorkerThread = class; + + { TFpThreadWorkerItem } + + TFpThreadWorkerItem = class + private const + TWSTATE_NEW = cardinal(0); + TWSTATE_RUNNING = cardinal(1); + TWSTATE_WAITING = cardinal(2); + TWSTATE_DONE = cardinal(3); + private + FDone: Cardinal; + FRefCnt: LongInt; + protected + procedure DoExecute; virtual; + procedure DoFinished; virtual; + + procedure Execute(MyWorkerThread: TFpWorkerThread); // called by worker thread + procedure WaitFor(AnMainWaitEvent: PRTLEvent); // called by main thread => calls DoExecute, if needed + procedure Cancel(AnMainWaitEvent: PRTLEvent); // called by main thread => calls DoExecute, if needed + public + procedure AddRef; + procedure DecRef; + end; + + { TFpWorkerThread } + + TFpWorkerThread = class(TThread) + private + FQueue: TFpThreadWorkerQueue; + public + constructor Create(AQueue: TFpThreadWorkerQueue); + procedure Execute; override; + property Queue: TFpThreadWorkerQueue read FQueue; + end; + + { TFpThreadWorkerQueue } + + TFpThreadWorkerQueue = class(specialize TLazThreadedQueue) + private type + TFpWorkerThreadList = specialize TFPGObjectList; + strict private + FWantedCount, FCurrentCount: Integer; + FThreadMonitor: TLazMonitor; + FWorkerThreadList: TFpWorkerThreadList; + FMainWaitEvent: PRTLEvent; + function GetCurrentCount: Integer; + function GetThreadCount: integer; + function GetWantedCount: Integer; + procedure SetThreadCount(AValue: integer); + protected + function RemoveThread(Item: TFpWorkerThread): Integer; + property WantedCount: Integer read GetWantedCount; + property CurrentCount: Integer read GetCurrentCount; + property ThreadMonitor: TLazMonitor read FThreadMonitor; + public + constructor Create(AQueueDepth: Integer = 10; PushTimeout: cardinal = INFINITE; PopTimeout: cardinal = INFINITE); + destructor Destroy; override; // Will not wait for the threads. + + procedure Clear; // Not thread safe // remove all none running items + function PushItem(const AItem: TFpThreadWorkerItem): TWaitResult; + + procedure WaitForItem(const AItem: TFpThreadWorkerItem); // called by main thread => calls DoExecute, if needed + procedure RemoveItem(const AItem: TFpThreadWorkerItem); // wait but do not execute + + property ThreadCount: integer read GetThreadCount write SetThreadCount; // Not thread safe + property MainWaitEvent: PRTLEvent read FMainWaitEvent; + end; + + { TFpGlobalThreadWorkerQueue } + + TFpGlobalThreadWorkerQueue = class(TFpThreadWorkerQueue) + private + FRefCnt: LongInt; + public + destructor Destroy; override; + procedure AddRef; + procedure DecRef; + end; function CompareUtf8BothCase(AnUpper, AnLower, AnUnknown: PChar): Boolean; @@ -57,6 +138,9 @@ procedure Log(const AText: String; const AParams: array of const); overload; procedure Log(const AText: String); overload; function FormatAddress(const AAddress): String; +function GetFpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue; + +property FpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue read GetFpDbgGlobalWorkerQueue; implementation @@ -64,6 +148,17 @@ uses LazLoggerBase, FpDbgClasses; +var + TheFpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue = nil; + +function GetFpDbgGlobalWorkerQueue: TFpGlobalThreadWorkerQueue; +begin + if TheFpDbgGlobalWorkerQueue = nil then + TheFpDbgGlobalWorkerQueue := TFpGlobalThreadWorkerQueue.Create(50); + + Result := TheFpDbgGlobalWorkerQueue; +end; + function CompareUtf8BothCase(AnUpper, AnLower, AnUnknown: PChar): Boolean; var p: PChar; @@ -232,5 +327,283 @@ begin DebugLn(AText); end; +type + + { TFpThreadWorkerTerminateItem } + + TFpThreadWorkerTerminateItem = class(TFpThreadWorkerItem) + end; + +{ TFpGlobalThreadWorkerQueue } + +destructor TFpGlobalThreadWorkerQueue.Destroy; +begin + Assert(InterLockedExchangeAdd(FRefCnt, 0) = 0); + inherited Destroy; +end; + +procedure TFpGlobalThreadWorkerQueue.AddRef; +begin + (* There are + - The current/fpdebug-main thread + - Maybe the IDE/main thread (if used LazDebuggerFp) + (however, fpdebug and IDE will rarely run both at high load => they can be counted as one) + - At least one, maybe more threads in the debugged target app + So no more than half the cpu-core count will be allocated for workers + *) + if InterLockedIncrement(FRefCnt) = 1 then + ThreadCount := Min(Max(1, GetSystemThreadCount div 2), 10); +end; + +procedure TFpGlobalThreadWorkerQueue.DecRef; +begin + if InterLockedDecrement(FRefCnt) = 0 then + ThreadCount := 0; +end; + +{ TFpThreadWorkerItem } + +procedure TFpThreadWorkerItem.DoExecute; +begin + // +end; + +procedure TFpThreadWorkerItem.DoFinished; +begin + if InterLockedExchangeAdd(FRefCnt, 0) <= 0 then + Destroy; +end; + +procedure TFpThreadWorkerItem.Execute(MyWorkerThread: TFpWorkerThread); +var + st: Cardinal; +begin + st := InterLockedExchange(FDone, TWSTATE_RUNNING); + if st = TWSTATE_NEW then begin + DoExecute; + + st := InterLockedExchange(FDone, TWSTATE_DONE); + if st = TWSTATE_WAITING then + RTLeventSetEvent(MyWorkerThread.Queue.MainWaitEvent); + end; +end; + +procedure TFpThreadWorkerItem.WaitFor(AnMainWaitEvent: PRTLEvent); +var + st: Cardinal; +begin + st := InterLockedExchange(FDone, TWSTATE_WAITING); + if st = TWSTATE_NEW then begin + DoExecute; + end + else + if st = TWSTATE_RUNNING then begin + RTLeventWaitFor(AnMainWaitEvent); + RTLeventResetEvent(AnMainWaitEvent); + end; +end; + +procedure TFpThreadWorkerItem.Cancel(AnMainWaitEvent: PRTLEvent); +var + st: Cardinal; +begin + st := InterLockedExchange(FDone, TWSTATE_WAITING); // Prevent thread form executing this + if st = TWSTATE_RUNNING then begin + RTLeventWaitFor(AnMainWaitEvent); + RTLeventResetEvent(AnMainWaitEvent); + end; +end; + +procedure TFpThreadWorkerItem.AddRef; +begin + InterLockedIncrement(FRefCnt); +end; + +procedure TFpThreadWorkerItem.DecRef; +begin + if Self = nil then + exit; + if InterLockedDecrement(FRefCnt) <= 0 then + DoFinished; +end; + +{ TFpWorkerThread } + +constructor TFpWorkerThread.Create(AQueue: TFpThreadWorkerQueue); +begin + FQueue := AQueue; + FreeOnTerminate := True; + inherited Create(False); +end; + +procedure TFpWorkerThread.Execute; +var + WorkItem: TFpThreadWorkerItem; +begin + while not Terminated do begin + FQueue.PopItem(WorkItem); + if WorkItem = nil then + Continue; + + if WorkItem is TFpThreadWorkerTerminateItem then begin + WorkItem.DecRef; + if Terminated then // no need to check + break; + + if FQueue.CurrentCount > FQueue.WantedCount then begin + FQueue.ThreadMonitor.Enter; + try + if FQueue.ThreadCount > FQueue.WantedCount then + break; + finally + FQueue.ThreadMonitor.Leave; + end; + end; + Continue; + end; + + WorkItem.Execute(Self); + WorkItem.DecRef; + end; + FQueue.RemoveThread(Self); +end; + +{ TFpThreadWorkerQueue } + +function TFpThreadWorkerQueue.GetThreadCount: integer; +begin + FThreadMonitor.Enter; + try + Result := FWorkerThreadList.Count; + finally + FThreadMonitor.Leave; + end; +end; + +function TFpThreadWorkerQueue.GetCurrentCount: Integer; +begin + Result := InterLockedExchangeAdd(FCurrentCount, 0); +end; + +function TFpThreadWorkerQueue.GetWantedCount: Integer; +begin + Result := InterLockedExchangeAdd(FWantedCount, 0); +end; + +procedure TFpThreadWorkerQueue.SetThreadCount(AValue: integer); +var + c: Integer; +begin + FThreadMonitor.Enter; + try + InterLockedExchange(FWantedCount, AValue); + FWantedCount := AValue; + + c := FWorkerThreadList.Count; + if c > AValue then begin + while c > AValue do begin + dec(c); + PushItem(TFpThreadWorkerTerminateItem.Create); // will terminate one thread, if no more work is to be done + end; + InterLockedExchange(FCurrentCount, FWorkerThreadList.Count); + end + + else + begin + // increase + FWorkerThreadList.Count := AValue; + InterLockedExchange(FCurrentCount, AValue); + while c < AValue do begin + FWorkerThreadList[c] := TFpWorkerThread.Create(Self); + inc(c); + end; + end; + finally + FThreadMonitor.Leave; + end; +end; + +function TFpThreadWorkerQueue.RemoveThread(Item: TFpWorkerThread): Integer; +begin + FThreadMonitor.Enter; + try + FWorkerThreadList.Remove(Item); + InterLockedExchange(FCurrentCount, FWorkerThreadList.Count); + finally + FThreadMonitor.Leave; + end; +end; + +constructor TFpThreadWorkerQueue.Create(AQueueDepth: Integer; + PushTimeout: cardinal; PopTimeout: cardinal); +begin + FThreadMonitor:=TLazMonitor.create; + inherited create(AQueueDepth, PushTimeout, PopTimeout); + FMainWaitEvent := RTLEventCreate; + FWorkerThreadList := TFpWorkerThreadList.Create(False); +end; + +destructor TFpThreadWorkerQueue.Destroy; +var + WorkItem: TFpThreadWorkerItem; + i: Integer; +begin + FThreadMonitor.Enter; + try + for i := 0 to FWorkerThreadList.Count - 1 do + FWorkerThreadList[i].Terminate; // also signals that the queue is no longer valid + finally + FThreadMonitor.Leave; + end; + + Clear; + ThreadCount := 0; + + // Wait for threads. + while CurrentCount > 0 do begin + sleep(1); + if TotalItemsPushed = TotalItemsPopped then + ThreadCount := 0; // Add more TFpThreadWorkerTerminateItem + end; + + // Free any TFpThreadWorkerTerminateItem items that were not picked up + Clear; + + inherited Destroy; + FWorkerThreadList.Free; + RTLeventdestroy(FMainWaitEvent); + FThreadMonitor.Free; +end; + +procedure TFpThreadWorkerQueue.Clear; +var + WorkItem: TFpThreadWorkerItem; +begin + while PopItemTimeout(WorkItem, 1) = wrSignaled do + WorkItem.DecRef; +end; + +function TFpThreadWorkerQueue.PushItem(const AItem: TFpThreadWorkerItem + ): TWaitResult; +begin + if TotalItemsPopped = TotalItemsPushed then + Grow(Min(QueueSize, 100)); + AItem.AddRef; + Result := inherited PushItem(AItem); +end; + +procedure TFpThreadWorkerQueue.RemoveItem(const AItem: TFpThreadWorkerItem); +begin + if AItem <> nil then + AItem.Cancel(Self.MainWaitEvent); +end; + +procedure TFpThreadWorkerQueue.WaitForItem(const AItem: TFpThreadWorkerItem); +begin + AItem.WaitFor(Self.MainWaitEvent); +end; + +finalization + TheFpDbgGlobalWorkerQueue.Free; end.