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

Данная статья иллюстрирует, как получить доступ к переменным из блока Thread Local Storage в Delphi. Однако принципы нахождения "чужого" блока TLS одинаковы для всех компиляторов Windows и применимы для любых языков программирования, поддерживающих TLS в том виде, как это определяет Windows.

В 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 данным было обусловлено только тем, что все прочие треды не имели доступа к данным текущего треда.

Ссылки по теме

• Купить программу Delphi XE3
• Каталог программ Embarcadero (CodeGear/Borland)
• Задать вопрос ONLine по покупке программ в интернет магазине ITShop
• Акция от компании Embarcadero "Получи Ultimate по цене Enterprise!"
• Акция от компании Embarcadero "Upgrade с любой предыдущей версии!"