diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index bb1361ba48..9980386e4f 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -211,11 +211,13 @@ type FStoreStepStartAddr, FStoreStepEndAddr: TDBGPtr; FStoreStepSrcLineNo: integer; FStoreStepFuncAddr: TDBGPtr; + FThreadNum: Integer; procedure LoadRegisterValues; virtual; property Process: TDbgProcess read FProcess; function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract; procedure DoBeforeBreakLocationMapChange; // A new location added / or a location removed => memory will change procedure ValidateRemovedBreakPointInfo; + function GetName: String; virtual; public constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); virtual; procedure DoBeforeProcessLoop; @@ -260,6 +262,8 @@ type procedure StoreStepInfo(AnAddr: TDBGPtr = 0); property ID: Integer read FID; property Handle: THandle read FHandle; + property Name: String read GetName; + property ThreadNum: Integer read FThreadNum; property NextIsSingleStep: boolean read FNextIsSingleStep write FNextIsSingleStep; property RegisterValueList: TDbgRegisterValueList read GetRegisterValueList; property CallStackEntryList: TDbgCallstackEntryList read FCallStackEntryList; @@ -2898,6 +2902,11 @@ begin FPausedAtRemovedBreakPointState := rbUnknown; end; +function TDbgThread.GetName: String; +begin + Result := 'Thread ' + IntToStr(FID); +end; + constructor TDbgThread.Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle); begin FID := AID; diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index 4b3359576d..229fa1bb5e 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -122,6 +122,8 @@ uses FpDbgCommon, FpdMemoryTools, FpErrorMessages; type + PPWSTR = ^PWSTR; + TGetThreadDescription = function(threadHandle: THandle; name: PPWSTR): HResult; stdcall; TFpWinCtxFlags = (cfSkip, cfControl, cfFull); TFpContextChangeFlag = (ccfControl, ccfInteger); @@ -143,6 +145,7 @@ type procedure LoadRegisterValues; override; function GetFpThreadContext(var AStorage: TFpContext; out ACtxPtr: PFpContext; ACtxFlags: TFpWinCtxFlags): Boolean; function SetFpThreadContext(ACtxPtr: PFpContext; ACtxFlags: TFpWinCtxFlags = cfSkip): Boolean; + function GetName: String; override; public procedure Suspend; procedure SuspendForStepOverBreakPoint; @@ -237,6 +240,8 @@ implementation var DBG_VERBOSE, DBG_WARNINGS, FPDBG_WINDOWS: PLazLoggerLogGroup; + KernelHandle : THandle; + GetThreadDescription: TGetThreadDescription; {$ifdef cpux86_64} const @@ -1594,6 +1599,22 @@ begin DebugLn(DBG_WARNINGS and (not Result), ['Unable to set Context for ', ID, ': ', GetLastErrorText]); end; +function TDbgWinThread.GetName: String; +var + n: PWSTR; +begin + if Assigned(GetThreadDescription) then begin + if Succeeded(GetThreadDescription(Handle, @n)) then begin + Result := WideCharToString(n); + LocalFree(HLOCAL(n)); + if Result = '' then + Result := inherited GetName; + end else + Result := inherited GetName; + end else + Result := inherited GetName; +end; + procedure TDbgWinThread.Suspend; var r: DWORD; @@ -1925,5 +1946,9 @@ initialization TX86AsmDecoder )); + KernelHandle := GetModuleHandle(KernelDLL); + if KernelHandle <> 0 then + GetThreadDescription := TGetThreadDescription(GetProcAddress(KernelHandle, 'GetThreadDescription')); + end. diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 23ed1e79d5..400f3530f2 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -916,21 +916,21 @@ begin if Assigned(CallStack) and (CallStack.Count > 0) then begin c := CallStack.Items[0]; if t = nil then begin - n := Threads.CurrentThreads.CreateEntry(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused'); + n := Threads.CurrentThreads.CreateEntry(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, FpThr.Name, 'paused'); Threads.CurrentThreads.Add(n); n.Free; end else - t.Init(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused'); + t.Init(c.AnAddress, nil, c.FunctionName, c.SourceFile, '', c.Line, FpThr.ID, FpThr.Name, 'paused'); end else begin if t = nil then begin - n := Threads.CurrentThreads.CreateEntry(0, nil, '', '', '', 0, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused'); + n := Threads.CurrentThreads.CreateEntry(0, nil, '', '', '', 0, FpThr.ID, FpThr.Name, 'paused'); Threads.CurrentThreads.Add(n); n.Free; end else - t.Init(0, nil, '', '', '', 0, FpThr.ID, 'Thread ' + IntToStr(FpThr.ID), 'paused'); + t.Init(0, nil, '', '', '', 0, FpThr.ID, FpThr.Name, 'paused'); end; end;