Доступ к переменным Thread local storage (TLS) любого треда

В Delphi, в отличии от глобальных переменных, переменные, объявленные в блоке threadvar, создаются для каждого потока (thread) с возможностью хранить независимые значения. Каждый поток читает и записывает свою копию значений.
Но иногда необходимо прочесть или даже изменить переменные, соответствующие другому треду.
Конечно, лучше изменить алгоритм, чтобы избежать такой необходимости, но решение этой задачи есть.
Все блоки данных (Thread local storage, TLS) находятся в памяти одновременно, но по разным адресам, каждый тред хранит указатель на свою область памяти, поэтому есть возможность найти блок переменных и конкретное значение, принадлежащее любому треду, созданному в пределах текущего процесса.

Область Thread local storage, в которой хранятся значения, определяется по значению из блока данных TEB. Адрес массива находится по смещению tlsArray (объявлено в модуле SysInit.pas).
При каждом обращении к переменной, объявленной как threadvar, происходит неявный вызов функции _GetTls, которая возвращает указатель на область данных текущего треда. Добавив смещение переменной, можно получить ее адрес.

Чтобы получить адрес переменной из другого треда, нужно вычесть адрес текущего блока и добавить адрес блока целевого треда.
Просто вызвать служебную функцию _GetTls невозможно, нужно вызывать ее из ассемблерного кода, добавив символ @ перед именем и название модуля System.

function GetCurrentTls: Pointer; asm   call System.@GetTls end; 

Этот же способ подходит для вызова большинства служебных функций, название которых начинается с подчеркивания, которые не вызываются обычным способом в коде Delphi:

call System.@НазваниеФункцииБезПодчеркивания 

Для начала напишем такую функцию:

function GetTlsAddress( hThread: THandle; Addr: Pointer ): Pointer; var   Offset: NativeInt; begin   Offset := ( PByte( Addr ) - PByte( GetCurrentTls ) );   Result := (?) + Offset; end; 

Функция принимает в качестве аргументов дескриптор (не идентификатор!) нужного нам треда и адрес переменной в текущем блоке переменных треда. Вернет функция адрес той же переменной, но относящейся уже к другому треду.

В первой строке мы получили смещение переменной относительно начала блока TLS.
Теперь нужно добавить это смещение к указателю области локальных переменных целевого треда, которое хранится в блоке данных TEB.

Смещение TEB треда в общем виртуальном пространстве процесса можно получить, вызвав функцию NtQueryInformationThread. Эта функция относится к числу Native-функций Windows, которые находятся в библиотеке ntdll.dll
Для ее использования можно подключить модуль JwaNative.pas из набора JEDI Win32 API или поместить непосредственно в текущий модуль объявление внешней функции с таким прототипом (необходимо подключение стандартного модуля Windows.pas):

type   THREAD_BASIC_INFORMATION = record     ExitStatus: ULONG{NTSTATUS};     TebBaseAddress: Pointer{PNT_TIB};     {ClientId: ;        // Поля закомментированы, чтобы не было необходимости добавлять      AffinityMask: ;     // определения других типов, которые сильно увеличат объем исходников     Priority: ;         // этого примера. В любом случае нам нужно только поле TebBaseAddress     BasePriority: ;}   end;  function NtQueryInformationThread(     ThreadHandle : THandle;     ThreadInformationClass : ULONG {THREADINFOCLASS};     ThreadInformation : PVOID;     ThreadInformationLength : ULONG;     ReturnLength : PULONG   ): ULONG; stdcall; external 'ntdll.dll'; 

Вместе с получением адреса TEB, функция теперь будет выглядеть так:

function GetTlsAddress( hThread: THandle; Addr: Pointer ): Pointer; var   basic: THREAD_BASIC_INFORMATION;   Len: ULONG;   Offset: NativeInt; begin   NtQueryInformationThread( hThread, 0{ThreadBasicInformation}, @basic, SizeOf( basic ), @Len );   Offset := ( PByte( Addr ) - PByte( GetCurrentTls ) );   Result := (?) + Offset; end; 

Теперь остается найти блок TLS в структуре PEB. Смотрим исходные коды SysInit, конкретно функцию _GetTls.

В 32-битной ОС адрес TLS массива (в котором под индексом TlsIndex находится адрес области данных треда) определяется таким кодом:

 MOV     EAX,TlsIndex  MOV     EDX,FS:[tlsArray]  MOV     EAX,[EDX+EAX*4] 

Для 64-битной таким:

 P := PPPointerArray(PByte(@GSSegBase) + tlsArray)^;  Result := P^[TlsIndex]; 

Несложная проверка может показать, что код для 64-битной версии так же работает и в 32-битной, если взять во внимание другое значение tlsArray, а также то, что TEB находится по адресу GS:[0], а не FS[0], как в 32-битной Windows.

Поскольку у нас уже есть адрес TEB (поле TebBaseAddress из структуры basic), который равен началу сегмента GS для Win64 и сегмента FS для Win32, то мы можем заменить значение @GSSegBase на полученный нами указатель TEB

 Tls := PPPointerArray( PByte( basic.TebBaseAddress ) + tlsArray )^; 

Полная функция с некоторой оптимизацией может выглядеть так:

function GetTlsAddress( hThread: THandle; Addr: Pointer ): Pointer; var   basic: THREAD_BASIC_INFORMATION;   Len: ULONG;   Tls: PPointerArray; begin   if hThread = GetCurrentThread then     Exit( Addr );   NtQueryInformationThread( hThread, 0{ThreadBasicInformation}, @basic, SizeOf( basic ), @Len );   Tls := PPPointerArray( PByte( basic.TebBaseAddress ) + tlsArray )^;   Result := PByte( Tls^[TlsIndex] ) + ( PByte( Addr ) - PByte( GetCurrentTls ) ); end; 

Для удобства использования данной функции в коде создадим класс с несколькими статичными методами:

type   TThreadLocalStorage = class   private     class function GetTlsAddress( hThread: THandle; Addr: Pointer ): Pointer; static;   public     class function GetThreadVar<T>( hThread: THandle; var TlsVar: T ): T; static;     class procedure SetThreadVar<T>( hThread: THandle; var TlsVar: T; const Value: T ); static;     class property Tls[hThread: THandle; Addr: Pointer]: Pointer read GetTlsAddress;   end; 

Тогда мы можем объявить следующие два метода:

class function TThreadLocalStorage.GetThreadVar<T>( hThread: THandle; var TlsVar: T ): T; begin   Result := T( GetTlsAddress( hThread, @TlsVar )^ ); end;  class procedure TThreadLocalStorage.SetThreadVar<T>( hThread: THandle; var TlsVar: T; const Value: T ); begin   T( GetTlsAddress( hThread, @TlsVar )^ ) := Value; end; 

При использовании параметризованных типов бывают трудности в объявлении указателя на тип T.
В таких случаях можно воспользоваться конструкциями такого типа:

X := T(PointerVar^); T(PointerVar^) := X; 

Delphi разрешает разыменование нетипизированного указателя, если сразу происходит преобразование типа или если такое значения без типа передается в функции напободие FillChar и Move (в которых аргументы объявлены так же без типа).

Теперь для доступа к переменной «чужого» треда можно использовать такой код:

threadvar TlsX; ... TThreadLocalStorage.GetThreadVar<Integer>( Thrd, TlsX ); 

А добавив такое объявление после класса TThreadLocalStorage:

type   TLS = TThreadLocalStorage; 

Можно еще сократить код:

 X := TLS.GetThreadVar<Integer>( Thrd, TlsX ); 

В качестве завершения, нужно отметить, что, при доступе к переменной из другого треда, надо помнить о синхронизации, как при доступе к глобальным переменным, доступным всем тредам. Это особенно относится к операциям Inc, Dec, а также к составным типам данных. Отсутствие необходимости синхронизировать доступ к threadvar данным было обусловлено только тем, что все прочие треды не имели доступа к данным текущего треда.