mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-17 21:19:24 +02:00
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:
parent
2721f3c588
commit
6c83060d4d
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user