Синхронизация потоков в Delphi

Атор: Вячеслав Минияров, Delphi Plus

Одно время пришлось плотно работать с потоками, причём с десяток методов требовали переключения в основной поток. Самое неприятное, что методы все с параметрами, причем разными. Наверняка я был не первый, кто объявлял массив вариантов, в который записывал параметры вызова, затем Synchronize(Caller), а в Caller - вызов той же функции с параметрами из массива. В конце концов мне это надоело: ведь все параметры вызываемого метода уже лежат в стеке! Стал думать, и вот что получилось:

Сначала - как это выглядит в коде:

// создаём и запускаем поток
procedure TForm1.Button1Click(Sender: TObject);
begin
  Th:= TVThread.Create;
end;

procedure TVThread.Execute;
var s: string;
begin
  // Form1.Test должна выполняться в контексте главного потока
  s:= Form1.Test(123, 'Abcd');
  Form1.Hint:= s;
end;

// параметры - любого типа, результат - тоже
function TForm1.Test(p1: integer; p2: string): string;
begin
  if Th.SFork then exit; // собственно, СИНХРОНИЗАЦИЯ
  ......                 // код для выполнения в основном потоке
  ......
end;

Симпатично? Мне нравится :)

А теперь о грустном:

• метод (или простая функция), вызывающая SFork, не может быть типа register: только pascal, cdecl или stdcall (почему - будет ясно ниже);
• если метод не статический (виртуальный или динамический) или вызван не напрямую (через переменную процедурного типа, например, или это Event), то вместо простого и красивого SFork придётся вызывать Fork:

  function TForm1.Test(p1: integer; p2: string): string;
  begin
    if Th.Fork(@TForm1.Test) then exit;
  ....
  

  с передачей ему адреса синхронизуемого метода.

Всё от того, что адрес точки входа в вызывающий метод можно определить только при прямой адресации и никак - при косвенной. :(

Естественно, Th.Fork(Pointer) можно использовать и для статических методов.

Реализация:

Метод Fork (SFork) сначала проверяет, в каком потоке его вызвали. Если это - главный поток, то ничего не делает, возвращает FALSE. Иначе вычисляет по содержимому стека начало и размер блока параметров вызвавшей его процедуры и запоминает эти данные в своих полях. Затем через стандартный Synchronize вызывается метод _Fork. _Fork, выполняясь уже в контексте главного потока, резервирует в стеке место, копирует в него блок параметров из стека заторможенного в это время потока и вызывает снова тот же метод (TForm1.Test в нашем примере). Этот метод теперь будет выполнен до конца, т.к. теперь Fork вернёт false.

По поводу безопасности кода: т.к. оба раза выполняется код входа в метод и код выхода из него, то все строки и пр. подобные типы, переданные как параметры, нормально увеличивают/уменьшают счётчики ссылок и нормально же отрабатывают автоматически добавляемые компилятором блоки try..finally..except.

  TVThread = class(TThread)
  private
    FRC: dword;      // адрес синхронизуемого метода
    FStart: dword;   // начало блока параметров этого метода
    FCount: dword;
  protected
    procedure _Fork;
    procedure ErrorCall; dynamic;
    procedure DoTerminate; override;
    procedure Execute; override;  // длина этого блока
  public
    function Fork(Func: Pointer): boolean;
    function SFork: boolean;
    constructor Create;  // только для статических методов!
  end;

procedure TVThread._Fork;
var savsi: dword;
    savdi: dword;
asm
    mov   savsi, ESI        // сохранить регистры
    mov   savdi, EDI
    mov   ESI, [EAX].FStart // src ptr
    mov   ECX, [EAX].FCount
    mov   EDX, [EAX].FRC
    sub   ESP, ECX
    mov   EDI, ESP          // dst ptr
    rep movsb               // копировать блок параметров
    mov   ESI, savsi        // восстановить регистры
    mov   EDI, savdi
    call  EDX               // вызвать синхронизуемый метод
end;

function TVThread.Fork(Func: Pointer): boolean;
begin
  asm
    mov  result, false
    push EAX                // save @Self
    call GetCurrentThreadId
    pop  ECX                // ECX = @Self
    cmp  EAX, MainThreadID
    jz   @@nothing          // если осн. поток - выход
    mov  result, true
    mov  EAX, Func
    mov  [ECX].FRC, EAX     // запомнить адрес метода
    mov  EAX, [EBP]         // EAX = EBP метода Func
// EBP перед вызовом Func и адрес возврата из Func нам не нужны
    lea  EDX, [EAX+8]
    mov  [ECX].FStart, EDX  // начало блока параметров
    mov  EAX, [EAX]         // ESP перед вызовом Func = конец блока
    sub  EAX, EDX           // длина блока
    mov  [ECX].FCount, EAX  // запомнить длину
    mov  AL, true           // продублировать result в AL
@@nothing:
  end;        // Synchronize лучше вызывать вне ASM блока, т.к.
              // компилятор тогда сам (и правильно) создаст
              // try..finally обрамление в операторах begin и end
  if result then
    Synchronize(_Fork);
end;

function TVThread.SFork: boolean;
var error: boolean;
begin
  asm
    mov  result, false
    push EAX                // save @Self
    call GetCurrentThreadId
    pop  ECX                // ECX = @Self
    cmp  EAX, MainThreadID
    jz   @@nothing          // если осн. поток - выход
    mov  result, true
    mov  error, true
    mov  EAX, [EBP]         // EAX = EBP вызвавшей процедуры
    mov  EAX, [EAX+4]       // EAX = адрес возврата из неё
  // вызов статического метода на ассемблере выглядит так:
  // первый байт - E8 (call), далее четыре байта - смещение
  // относительно адреса следующей инструкции.
  // адрес возврата указывает именно на эту следующую инструкцию
    cmp  byte ptr [EAX-5],0E8h  // проверить способ вызова
    jne  @@nothing              // Ошибка! Не прямой вызов.
    mov  error, false
    add  EAX, [EAX-4]       // EAX = caller entry point
    mov  [ECX].FRC, EAX     // сохранить адрес вызвавшей процедуры
    mov  EAX, [EBP]         // далее всё идентично Fork
    lea  EDX, [EAX+8]
    mov  [ECX].FStart, EDX
    mov  EAX, [EAX]
    sub  EAX, EDX
    mov  [ECX].FCount, EAX
    mov  AL, true
@@nothing:
  end;
  if not result then exit;
  if error then begin
    ErrorCall;     // в наследнике можно обругаться по своему
    // если Exception всё же не был вызван в ErrorCall..
    raise Exception.Create(
          'TVThread.SFork: Error Calling conventions!');
  end else
    Synchronize(_Fork);
end;

procedure TVThread.ErrorCall;
begin
end;