paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 11:18:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

First attempt: Name threads for debugging

Browse Source
This commit is contained in:
Pascal Riekenberg 2022-04-19 23:28:26 +02:00
parent eb35a68284
commit 44e79eb0d4
3 changed files with 38 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpdebug/fpdbgclasses.pp
View File

@ -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;

25
components/fpdebug/fpdbgwinclasses.pas
View File

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

8
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -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;