View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0036941 | FPC | RTL | public | 2020-04-20 22:07 | 2020-05-03 23:40 |
Reporter | Bi0T1N | Assigned To | Sven Barth | ||
Priority | normal | Severity | minor | Reproducibility | always |
Status | closed | Resolution | fixed | ||
Product Version | 3.3.1 | ||||
Fixed in Version | 3.3.1 | ||||
Summary | 0036941: [Patch] Implement thread naming for Windows | ||||
Description | This patch implements thread naming for the Windows platform. See https://docs.microsoft.com/en-us/visualstudio/debugger/how-to-set-a-thread-name-in-native-code?view=vs-2019 There are two 'open' issues: 1. According to the Microsoft Docs page the record is aligned/packed, so it might need something like Align(@thrdinfo, 8); or packed record but here (Win 10 64bit) it's working fine without all of this. 2. If THREADNAME_IS_ANSISTRING gets defined the cast to AnsiString isn't needed. If it is not defined the UnicodeString cast can be removed. I'm not sure which definition should be favoured. Both lines are marked in the patch. | ||||
Additional Information | This patch bases on the changes from https://bugs.freepascal.org/view.php?id=36940 | ||||
Tags | No tags attached. | ||||
Fixed in Revision | 45206 | ||||
FPCOldBugId | |||||
FPCTarget | - | ||||
Attached Files |
|
related to | 0036940 | closed | Sven Barth | [Patch] Add support for naming threads to TThreadManager |
|
01-Implement_ThreadSetName_for_Windows.patch (4,503 bytes)
diff --git rtl/win/systhrd.inc rtl/win/systhrd.inc index 5eee904c56..c1982d73c0 100644 --- rtl/win/systhrd.inc +++ rtl/win/systhrd.inc @@ -51,6 +51,16 @@ function TerminateThread (threadHandle : THandle; var exitCode : dword) : bool function WaitForSingleObject (hHandle : THandle;Milliseconds: dword): dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'WaitForSingleObject'; function WinThreadSetPriority (threadHandle : THandle; Prio: longint): boolean; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'SetThreadPriority'; function WinThreadGetPriority (threadHandle : THandle): LongInt; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetThreadPriority'; +function WinGetCurrentThread: THandle; stdcall; external KernelDLL name 'GetCurrentThread'; +function WinOpenThread(dwDesiredAccess: DWord; bInheritHandle: Boolean; dwThreadId: DWord): THandle; stdcall; external KernelDLL name 'OpenThread'; +function WinIsDebuggerPresent: Boolean; stdcall; external KernelDLL name 'IsDebuggerPresent'; +procedure WinRaiseException(dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWord; const lpArguments: PUInt64); stdcall; external KernelDLL name 'RaiseException'; +{$ifndef WINCE} +type + TSetThreadDescription = function(threadHandle: THandle; lpThreadDescription: PWideChar): HResult; stdcall; +var + WinSetThreadDescription: TSetThreadDescription; +{$endif WINCE} {$ifndef WINCE} function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; external KernelDLL name 'CreateEventA'; function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'ResetEvent'; @@ -339,8 +349,47 @@ var end; procedure SysThreadSetName(threadHandle: TThreadID; const ThreadName: String); + const + MS_VC_EXCEPTION: DWord = $406D1388; + type + THREADNAME_INFO = record + dwType: DWord; // Must be 0x1000. + szName: PAnsiChar; // Pointer to name (in user addr space). + dwThreadID: DWord; // Thread ID (-1=caller thread). + dwFlags: DWord; // Reserved for future use, must be zero. + end; + var + thrdhandle: THandle; + thrdinfo: THREADNAME_INFO; begin - {$Warning ThreadSetName needs to be implemented} + if WinIsDebuggerPresent then + begin + // supported on older Windows versions AND currently only supported method by GDB + thrdinfo.dwType:=$1000; + thrdinfo.szName:=@AnsiString(ThreadName)[1]; // <-- depends on THREADNAME_IS_ANSISTRING + thrdinfo.dwThreadID:=threadHandle; + thrdinfo.dwFlags:=0; + try + WinRaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(DWord), @thrdinfo); + except + end; + end + else + begin + if Assigned(WinSetThreadDescription) then + begin + // at least Windows 10 version 1607 or Windows Server 2016 + if threadHandle=TThreadID(-1) then + begin + thrdhandle:=WinGetCurrentThread; + end + else + begin + thrdhandle:=WinOpenThread($0400, False, threadHandle); + end; + WinSetThreadDescription(thrdhandle, @UnicodeString(ThreadName)[1]); // <-- depends on THREADNAME_IS_ANSISTRING + end; + end; end; {***************************************************************************** @@ -502,10 +551,10 @@ Var WinThreadManager : TThreadManager; Procedure InitSystemThreads;public name '_FPC_InitSystemThreads'; -{$IFDEF SUPPORT_WIN95} +{$ifndef WINCE} var KernelHandle : THandle; -{$ENDIF SUPPORT_WIN95} +{$endif} begin With WinThreadManager do begin @@ -550,13 +599,24 @@ begin if IsLibrary then {$endif} SysInitTLS; + +{$ifndef WINCE} + KernelHandle:=GetModuleHandle(KernelDLL); +{$endif} + {$IFDEF SUPPORT_WIN95} { Try to find TryEnterCriticalSection function } - KernelHandle:=GetModuleHandle(KernelDLL); if KernelHandle<>0 then WinTryEnterCriticalSection:=TTryEnterCriticalSection(WinGetProcAddress(KernelHandle,'TryEnterCriticalSection')); if not assigned(WinTryEnterCriticalSection) then WinTryEnterCriticalSection:=@Win95TryEnterCriticalSection; {$ENDIF SUPPORT_WIN95} + +{$ifndef WINCE} + if KernelHandle<>0 then + begin + WinSetThreadDescription:=TSetThreadDescription(WinGetProcAddress(KernelHandle, 'SetThreadDescription')); + end; +{$endif WINCE} end; |
|
Attached a small demo project and some screenshots. Please note that you need at least GDB 8.0 for showing thread names on Windows. namethreads.pas (1,086 bytes)
program namethreads; {$mode Delphi} uses SysUtils, Classes; type TMyThread = class(TThread) private i: Integer; protected procedure Execute; override; procedure SetNumber(const aNum: Integer); end; procedure TMyThread.Execute; begin writeln('hello from thread '+ThreadID.ToString); NameThreadForDebugging(IntToStr(i)); sleep(30000); end; procedure TMyThread.SetNumber(const aNum: Integer); begin i := aNum + 1; end; var threads: TArray<TMyThread>; i: Integer; thread: TMyThread; begin writeln('start'); SetLength(threads, 5); for i := Low(threads) to High(threads) do begin threads[i] := TMyThread.Create(True); threads[i].SetNumber(i); end; for thread in threads do begin thread.Start; end; sleep(10000); TMyThread.NameThreadForDebugging('bronze', threads[2].ThreadID); // third thread TMyThread.NameThreadForDebugging('always number one'); // main thread for thread in threads do begin thread.WaitFor; end; writeln('done'); readln; end. |
|
Updated patch after 0036940 got merged. - wasn't sure if code duplication or string conversion should be avoided - decided for avoiding string conversions inside SysSetThreadDebugNameA/U. - adapted the code slightly so that both methods can be used together as stated on the MS Docs: "It is worth noting that both approaches can be used together, if desired, since the mechanisms by which they work are independent of each other." (https://docs.microsoft.com/en-us/visualstudio/debugger/how-to-set-a-thread-name-in-native-code?view=vs-2019) 01-Implement_Ansi_and_Unicode_ThreadSetName_for_Windows.patch (5,154 bytes)
diff --git rtl/win/systhrd.inc rtl/win/systhrd.inc index 6ab7f8f0b2..ee7e08dbe3 100644 --- rtl/win/systhrd.inc +++ rtl/win/systhrd.inc @@ -51,6 +51,16 @@ function TerminateThread (threadHandle : THandle; var exitCode : dword) : bool function WaitForSingleObject (hHandle : THandle;Milliseconds: dword): dword; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'WaitForSingleObject'; function WinThreadSetPriority (threadHandle : THandle; Prio: longint): boolean; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'SetThreadPriority'; function WinThreadGetPriority (threadHandle : THandle): LongInt; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetThreadPriority'; +function WinGetCurrentThread: THandle; stdcall; external KernelDLL name 'GetCurrentThread'; +function WinOpenThread(dwDesiredAccess: DWord; bInheritHandle: Boolean; dwThreadId: DWord): THandle; stdcall; external KernelDLL name 'OpenThread'; +function WinIsDebuggerPresent: Boolean; stdcall; external KernelDLL name 'IsDebuggerPresent'; +procedure WinRaiseException(dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWord; const lpArguments: PUInt64); stdcall; external KernelDLL name 'RaiseException'; +{$ifndef WINCE} +type + TSetThreadDescription = function(threadHandle: THandle; lpThreadDescription: PWideChar): HResult; stdcall; +var + WinSetThreadDescription: TSetThreadDescription; +{$endif WINCE} {$ifndef WINCE} function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; external KernelDLL name 'CreateEventA'; function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'ResetEvent'; @@ -338,14 +348,71 @@ var SysGetCurrentThreadId:=Win32GetCurrentThreadId; end; + { following method is supported on older Windows versions AND currently only supported method by GDB } + procedure RaiseMSVCExceptionMethod(threadHandle: TThreadID; const ThreadName: AnsiString); + const + MS_VC_EXCEPTION: DWord = $406D1388; + type + THREADNAME_INFO = record + dwType: DWord; // Must be 0x1000. + szName: PAnsiChar; // Pointer to name (in user addr space). + dwThreadID: DWord; // Thread ID (-1=caller thread). + dwFlags: DWord; // Reserved for future use, must be zero. + end; + var + thrdinfo: THREADNAME_INFO; + begin + thrdinfo.dwType:=$1000; + thrdinfo.szName:=@ThreadName[1]; + thrdinfo.dwThreadID:=threadHandle; + thrdinfo.dwFlags:=0; + try + WinRaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(DWord), @thrdinfo); + except + {do nothing} + end; + end; + + { following method needs at least Windows 10 version 1607 or Windows Server 2016 } + procedure SetThreadDescriptionMethod(threadHandle: TThreadID; const ThreadName: UnicodeString); + var + thrdhandle: THandle; + begin + if threadHandle=TThreadID(-1) then + begin + thrdhandle:=WinGetCurrentThread; + end + else + begin + thrdhandle:=WinOpenThread($0400, False, threadHandle); + end; + WinSetThreadDescription(thrdhandle, @ThreadName[1]); + end; + procedure SysSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString); begin - {$Warning SetThreadDebugNameA needs to be implemented} + if WinIsDebuggerPresent then + begin + RaiseMSVCExceptionMethod(threadHandle, ThreadName); + end; + + if Assigned(WinSetThreadDescription) then + begin + SetThreadDescriptionMethod(threadHandle, UnicodeString(ThreadName)); + end; end; procedure SysSetThreadDebugNameU(threadHandle: TThreadID; const ThreadName: UnicodeString); begin - {$Warning SetThreadDebugNameU needs to be implemented} + if WinIsDebuggerPresent then + begin + RaiseMSVCExceptionMethod(threadHandle, AnsiString(ThreadName)); + end; + + if Assigned(WinSetThreadDescription) then + begin + SetThreadDescriptionMethod(threadHandle, ThreadName); + end; end; {***************************************************************************** @@ -507,10 +574,10 @@ Var WinThreadManager : TThreadManager; Procedure InitSystemThreads;public name '_FPC_InitSystemThreads'; -{$IFDEF SUPPORT_WIN95} +{$ifndef WINCE} var KernelHandle : THandle; -{$ENDIF SUPPORT_WIN95} +{$endif} begin With WinThreadManager do begin @@ -556,6 +623,11 @@ begin if IsLibrary then {$endif} SysInitTLS; + +{$ifndef WINCE} + KernelHandle:=GetModuleHandle(KernelDLL); +{$endif} + {$IFDEF SUPPORT_WIN95} { Try to find TryEnterCriticalSection function } KernelHandle:=GetModuleHandle(KernelDLL); @@ -564,5 +636,12 @@ begin if not assigned(WinTryEnterCriticalSection) then WinTryEnterCriticalSection:=@Win95TryEnterCriticalSection; {$ENDIF SUPPORT_WIN95} + +{$ifndef WINCE} + if KernelHandle<>0 then + begin + WinSetThreadDescription:=TSetThreadDescription(WinGetProcAddress(KernelHandle, 'SetThreadDescription')); + end; +{$endif WINCE} end; |
|
Following remarks: - the string conversion is fine as you did it - remove the KernelHandle assignment inside the SUPPORT_WIN95 define (otherwise KernelHandle would be assigned twice if that is defined) - don't you need to close the thread you opened with OpenThread after the call to SetThreadDescription? - RaiseException is already imported in syswin.inc, maybe move that to sysos.inc (and use "RaiseException" instead of "WinRaiseException" then) |
|
Fixed your remarks in the attached patch for an easy review. Should be applied on top of the previous one. 02-Implement_Ansi_and_Unicode_ThreadSetName_for_Windows.patch (3,514 bytes)
diff --git rtl/win/sysos.inc rtl/win/sysos.inc index a85f424900..83a1eda5f1 100644 --- rtl/win/sysos.inc +++ rtl/win/sysos.inc @@ -231,6 +231,9 @@ type procedure SetLastError(dwErrCode : DWORD); {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'SetLastError'; + procedure RaiseException(dwExceptionCode: DWORD; dwExceptionFlags: DWORD; dwArgCount: DWORD; lpArguments: Pointer); + {$ifdef wince}cdecl{$else}stdcall{$endif}; external KernelDLL name 'RaiseException'; + { time and date functions } function GetTickCount : DWORD; {$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'GetTickCount'; diff --git rtl/win/systhrd.inc rtl/win/systhrd.inc index ee7e08dbe3..4a929b16d4 100644 --- rtl/win/systhrd.inc +++ rtl/win/systhrd.inc @@ -54,7 +54,6 @@ function WinThreadGetPriority (threadHandle : THandle): LongInt; {$ifdef wince} function WinGetCurrentThread: THandle; stdcall; external KernelDLL name 'GetCurrentThread'; function WinOpenThread(dwDesiredAccess: DWord; bInheritHandle: Boolean; dwThreadId: DWord): THandle; stdcall; external KernelDLL name 'OpenThread'; function WinIsDebuggerPresent: Boolean; stdcall; external KernelDLL name 'IsDebuggerPresent'; -procedure WinRaiseException(dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWord; const lpArguments: PUInt64); stdcall; external KernelDLL name 'RaiseException'; {$ifndef WINCE} type TSetThreadDescription = function(threadHandle: THandle; lpThreadDescription: PWideChar): HResult; stdcall; @@ -367,7 +366,7 @@ var thrdinfo.dwThreadID:=threadHandle; thrdinfo.dwFlags:=0; try - WinRaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(DWord), @thrdinfo); + RaiseException(MS_VC_EXCEPTION, 0, SizeOf(thrdinfo) div SizeOf(DWord), @thrdinfo); except {do nothing} end; @@ -377,16 +376,25 @@ var procedure SetThreadDescriptionMethod(threadHandle: TThreadID; const ThreadName: UnicodeString); var thrdhandle: THandle; + ClosingNeeded: Boolean; begin if threadHandle=TThreadID(-1) then begin thrdhandle:=WinGetCurrentThread; + ClosingNeeded:=False; end else begin thrdhandle:=WinOpenThread($0400, False, threadHandle); + ClosingNeeded:=True; end; + WinSetThreadDescription(thrdhandle, @ThreadName[1]); + + if ClosingNeeded then + begin + CloseHandle(thrdhandle); + end; end; procedure SysSetThreadDebugNameA(threadHandle: TThreadID; const ThreadName: AnsiString); @@ -630,7 +638,6 @@ begin {$IFDEF SUPPORT_WIN95} { Try to find TryEnterCriticalSection function } - KernelHandle:=GetModuleHandle(KernelDLL); if KernelHandle<>0 then WinTryEnterCriticalSection:=TTryEnterCriticalSection(WinGetProcAddress(KernelHandle,'TryEnterCriticalSection')); if not assigned(WinTryEnterCriticalSection) then diff --git rtl/win/syswin.inc rtl/win/syswin.inc index 7204e6797e..e61833a70e 100644 --- rtl/win/syswin.inc +++ rtl/win/syswin.inc @@ -130,14 +130,6 @@ type TExceptClsProc=function(code: Longint): Pointer; { ExceptClass } -procedure RaiseException( - dwExceptionCode: DWORD; - dwExceptionFlags: DWORD; - dwArgCount: DWORD; - lpArguments: Pointer); // msdn: *ULONG_PTR - stdcall; external 'kernel32.dll' name 'RaiseException'; - - function RunErrorCode(const rec: TExceptionRecord): longint; begin { negative result means 'FPU reset required' } |
|
Thank you. I've applied your patch with the added difference that I've disabled it for Windows CE (for now). Please test and close if okay. |
Date Modified | Username | Field | Change |
---|---|---|---|
2020-04-20 22:07 | Bi0T1N | New Issue | |
2020-04-20 22:07 | Bi0T1N | File Added: 01-Implement_ThreadSetName_for_Windows.patch | |
2020-04-20 22:12 | Bi0T1N | Note Added: 0122304 | |
2020-04-20 22:12 | Bi0T1N | File Added: namethreads.pas | |
2020-04-20 22:12 | Bi0T1N | File Added: gdb.PNG | |
2020-04-20 22:12 | Bi0T1N | File Added: processhacker.PNG | |
2020-04-20 22:12 | Bi0T1N | File Added: x64dbg_1.PNG | |
2020-04-20 22:12 | Bi0T1N | File Added: x64dbg_2.PNG | |
2020-04-22 10:30 | Sven Barth | Relationship added | related to 0036940 |
2020-04-28 22:49 | Bi0T1N | Note Added: 0122514 | |
2020-04-28 22:49 | Bi0T1N | File Added: 01-Implement_Ansi_and_Unicode_ThreadSetName_for_Windows.patch | |
2020-04-29 12:31 | Sven Barth | Note Added: 0122521 | |
2020-04-29 16:03 | Bi0T1N | Note Added: 0122526 | |
2020-04-29 16:03 | Bi0T1N | File Added: 02-Implement_Ansi_and_Unicode_ThreadSetName_for_Windows.patch | |
2020-05-01 14:50 | Sven Barth | Assigned To | => Sven Barth |
2020-05-01 14:50 | Sven Barth | Status | new => assigned |
2020-05-01 15:11 | Sven Barth | Status | assigned => resolved |
2020-05-01 15:11 | Sven Barth | Resolution | open => fixed |
2020-05-01 15:11 | Sven Barth | Fixed in Version | => 3.3.1 |
2020-05-01 15:11 | Sven Barth | Fixed in Revision | => 45206 |
2020-05-01 15:11 | Sven Barth | FPCTarget | => - |
2020-05-01 15:11 | Sven Barth | Note Added: 0122578 | |
2020-05-03 23:40 | Bi0T1N | Status | resolved => closed |