FpDebug: cache received threadnames, if the thread is not yet known (may be suspended). Issue #40699 Patch by Red_prig (Pavel)

This commit is contained in:
Martin 2024-01-28 12:56:32 +01:00
parent 2721f3c588
commit 6c83060d4d

View File

@ -111,6 +111,7 @@ uses
Classes, Classes,
SysUtils, SysUtils,
Windows, Windows,
LazLinkedList,
FpDbgUtil, FpDbgUtil,
FpDbgClasses, FpDbgClasses,
process, process,
@ -178,6 +179,27 @@ type
property Process; property Process;
end; end;
TDbgWinThreadNameInternal = class(TLinkListItem)
Fid: TThreadID;
Fthreadname: shortstring;
procedure SetInfo(id:TThreadID;const threadname:string);
end;
TDbgWinThreadNameList = class(TLinkList)
private
const
FMaxCounter = 10000;
var
FNumCounter: integer;
protected
function CreateItem: TLinkListItem; override;
public
procedure ClearThread;
function FindById(id:TThreadID):TDbgWinThreadNameInternal;
function FetchThread(id:TThreadID):string;
function AddThread(id:TThreadID;const threadname:string):Boolean;
end;
{ TDbgWinProcess } { TDbgWinProcess }
TDbgWinProcess = class(TDbgProcess) TDbgWinProcess = class(TDbgProcess)
@ -186,6 +208,7 @@ type
FProcProcess: TProcessUTF8; FProcProcess: TProcessUTF8;
FJustStarted, FTerminated: boolean; FJustStarted, FTerminated: boolean;
FBitness: TBitness; FBitness: TBitness;
FThreadNameList: TDbgWinThreadNameList;
function GetFullProcessImageName(AProcessHandle: THandle): string; function GetFullProcessImageName(AProcessHandle: THandle): string;
function GetModuleFileName(AModuleHandle: THandle): string; function GetModuleFileName(AModuleHandle: THandle): string;
function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string; function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string;
@ -375,6 +398,85 @@ begin
{$endif} {$endif}
end; end;
//TDbgWinThreadName
procedure TDbgWinThreadNameInternal.SetInfo(id:TThreadID;const threadname:string);
begin
Fid:=id;
Fthreadname:=threadname;
end;
//
function TDbgWinThreadNameList.CreateItem: TLinkListItem;
begin
Result:=TLinkListItem(TDbgWinThreadNameInternal.Create);
end;
procedure TDbgWinThreadNameList.ClearThread;
begin
Clear;
FNumCounter:=0;
end;
function TDbgWinThreadNameList.FindById(id:TThreadID):TDbgWinThreadNameInternal;
var
node:TDbgWinThreadNameInternal;
begin
Result:=nil;
node:=TDbgWinThreadNameInternal(First);
while (node<>nil) do
begin
if (node.Fid=id) then
begin
Exit(node);
end;
node:=TDbgWinThreadNameInternal(node.Next);
end;
end;
function TDbgWinThreadNameList.FetchThread(id:TThreadID):string;
var
node:TDbgWinThreadNameInternal;
begin
Result:='';
node:=FindById(id);
if (node<>nil) then
begin
Result:=node.Fthreadname;
Delete(TLinkListItem(node));
Dec(FNumCounter);
end;
end;
function TDbgWinThreadNameList.AddThread(id:TThreadID;const threadname:string):Boolean;
var
node:TDbgWinThreadNameInternal;
begin
node:=FindById(id);
if (node<>nil) then
begin
node.SetInfo(id,threadname);
end else
begin
if (FNumCounter>=FMaxCounter) then
begin
//limit
Exit(False);
end;
node:=TDbgWinThreadNameInternal(GetNewItem);
node.SetInfo(id,threadname);
AddAsLast(TLinkListItem(node));
Inc(FNumCounter);
end;
Result:=True;
end;
//TThreadNameMap
procedure TDbgWinProcess.LogLastError(AMsg: String); procedure TDbgWinProcess.LogLastError(AMsg: String);
begin begin
if not GotExitProcess then if not GotExitProcess then
@ -564,6 +666,7 @@ begin
{$else} {$else}
FBitness := b64; FBitness := b64;
{$endif} {$endif}
FThreadNameList := TDbgWinThreadNameList.Create;
inherited Create(AFileName, AnOsClasses, AMemManager, AMemModel, AProcessConfig); inherited Create(AFileName, AnOsClasses, AMemManager, AMemModel, AProcessConfig);
end; end;
@ -571,6 +674,7 @@ destructor TDbgWinProcess.Destroy;
begin begin
FInfo.hProcess:=0; FInfo.hProcess:=0;
FProcProcess.Free; FProcProcess.Free;
FThreadNameList.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -762,6 +866,9 @@ begin
FProcProcess.Execute; FProcProcess.Execute;
Init(FProcProcess.ProcessID, 0); Init(FProcProcess.ProcessID, 0);
FThreadNameList.ClearThread;
Result:=true; Result:=true;
except except
on E: Exception do on E: Exception do
@ -798,6 +905,9 @@ begin
end; end;
Init(APid, 0); Init(APid, 0);
FThreadNameList.ClearThread;
Result := true; Result := true;
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info // TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end; end;
@ -1027,6 +1137,7 @@ begin
end; end;
EXIT_PROCESS_DEBUG_EVENT: begin EXIT_PROCESS_DEBUG_EVENT: begin
// Should never be here, since it detached // Should never be here, since it detached
FThreadNameList.ClearThread;
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE); Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
Done := False; Done := False;
end; end;
@ -1369,6 +1480,10 @@ begin
FName := threadname; FName := threadname;
FDoNotPollName := True; FDoNotPollName := True;
end; end;
end else
with MDebugEvent.Exception.ExceptionRecord do
begin
FThreadNameList.AddThread(TThreadID(ExceptionInformation[2]),threadname);
end; end;
end; end;
result := deInternalContinue; result := deInternalContinue;
@ -1411,6 +1526,7 @@ begin
SetExitCode(MDebugEvent.ExitProcess.dwExitCode); SetExitCode(MDebugEvent.ExitProcess.dwExitCode);
// Let the kernel close all debug-handles and close-up the // Let the kernel close all debug-handles and close-up the
// debuggee. // debuggee.
FThreadNameList.ClearThread;
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE); Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
result := deExitProcess; result := deExitProcess;
end; end;
@ -1440,6 +1556,8 @@ begin
end; end;
function TDbgWinProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; function TDbgWinProcess.CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread;
var
threadname: string;
begin begin
case MDebugEvent.dwDebugEventCode of case MDebugEvent.dwDebugEventCode of
CREATE_THREAD_DEBUG_EVENT : CREATE_THREAD_DEBUG_EVENT :
@ -1455,6 +1573,17 @@ begin
else else
result := nil; result := nil;
end; {case} end; {case}
if (result<>nil) then
begin
threadname:=FThreadNameList.FetchThread(result.ID);
if (threadname<>'') then
with TDbgWinThread(result) do
begin
FName := threadname;
FDoNotPollName := True;
end;
end;
end; end;
procedure TDbgWinProcess.StartProcess(const AThreadID: DWORD;const AInfo: TCreateProcessDebugInfo); procedure TDbgWinProcess.StartProcess(const AThreadID: DWORD;const AInfo: TCreateProcessDebugInfo);
@ -1517,6 +1646,7 @@ procedure TDbgWinProcess.TerminateProcess;
begin begin
Windows.TerminateProcess(Handle, 0); Windows.TerminateProcess(Handle, 0);
FTerminated := True; FTerminated := True;
FThreadNameList.ClearThread;
end; end;
function TDbgWinProcess.AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary; function TDbgWinProcess.AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;