Как работает TMulticastEvent Аллена Бауэра <T> - PullRequest
Новая
       20

Как работает TMulticastEvent Аллена Бауэра <T>

18 голосов
/ 04 августа 2009

Я копался с кодом Аллена Бауэра для общего диспетчера многоадресных событий (см. Его сообщения в блоге об этом здесь ).

Он дает достаточно кода, чтобы я захотел его использовать, и, к сожалению, он не опубликовал полный исходный код. У меня была попытка заставить его работать, но мои навыки ассемблера отсутствуют.

Моя проблема - метод InternalSetDispatcher. Наивный подход заключается в использовании того же ассемблера, что и для других методов InternalXXX: 

procedure InternalSetDispatcher;
begin
   XCHG  EAX,[ESP]
   POP   EAX
   POP   EBP
   JMP   SetEventDispatcher
end;

Но это используется для процедур с одним параметром const, например: 

procedure Add(const AMethod: T); overload;

И SetDispatcher имеет два параметра, один из которых: 

procedure SetEventDispatcher(var ADispatcher: T; ATypeData: PTypeData);

Итак, я предполагаю, что стек будет поврежден. Я знаю, что делает код (очищает кадр стека от вызова InternalSetDispatcher, выдвигая скрытую ссылку на себя, и я предполагаю адрес возврата), но я просто не могу понять, что немного ассемблера, чтобы получить весь дело идет.

РЕДАКТИРОВАТЬ: Просто чтобы уточнить, что я ищу, это ассемблер, который я мог бы использовать, чтобы заставить работать метод InternalSetDispatcher, т.е. ассемблер для очистки стека процедуры с двумя параметрами, одним из которых является переменная.

РЕДАКТИРОВАТЬ2: Я немного исправил вопрос, спасибо Мейсон за его ответы до сих пор. Я должен упомянуть, что приведенный выше код не работает, и когда SetEventDispatcher возвращается, AV поднимается.

Ответы [ 2 ]

15 голосов
/ 04 августа 2009

Ответ, после того, как я много бегал по сети, заключается в том, что ассемблер предполагает наличие фрейма стека при вызове InternalSetDispatcher.

Похоже, что кадр стека не генерировался для вызова InternalSetDispatcher.

Итак, исправить это так же просто, как включить фреймы стека с помощью директивы компилятора {$ stackframes on} и перестроить.

Спасибо, Мейсон, за помощь в получении ответа на этот вопрос. :)

Редактировать 2012-08-08 : Если вы заинтересованы в использовании этого, вы можете проверить реализацию в Delphi Sping Framework . Я не проверял его, но похоже, что он обрабатывает различные соглашения о вызовах лучше, чем этот код.

Редактировать: В соответствии с моей просьбой моя интерпретация кода Алана приведена ниже. Вдобавок к необходимости включения стековых фреймов, мне также нужно было включить оптимизацию на уровне проекта , чтобы это работало: 

unit MulticastEvent;

interface

uses
  Classes, SysUtils, Generics.Collections, ObjAuto, TypInfo;

type

  // you MUST also have optimization turned on in your project options for this
  // to work! Not sure why.
  {$stackframes on}
  {$ifopt O-}
    {$message Fatal 'optimisation _must_ be turned on for this unit to work!'}
  {$endif}
  TMulticastEvent = class
  strict protected
    type TEvent = procedure of object;
  strict private
    FHandlers: TList<TMethod>;
    FInternalDispatcher: TMethod;

    procedure InternalInvoke(Params: PParameters; StackSize: Integer);
    procedure SetDispatcher(var AMethod: TMethod; ATypeData: PTypeData);
    procedure Add(const AMethod: TEvent); overload;
    procedure Remove(const AMethod: TEvent); overload;
    function IndexOf(const AMethod: TEvent): Integer; overload;
  protected
    procedure InternalAdd;
    procedure InternalRemove;
    procedure InternalIndexOf;
    procedure InternalSetDispatcher;

  public
    constructor Create;
    destructor Destroy; override;

  end;

  TMulticastEvent<T> = class(TMulticastEvent)
  strict private
    FInvoke: T;
    procedure SetEventDispatcher(var ADispatcher: T; ATypeData: PTypeData);
  public
    constructor Create;
    procedure Add(const AMethod: T); overload;
    procedure Remove(const AMethod: T); overload;
    function IndexOf(const AMethod: T): Integer; overload;

    property Invoke: T read FInvoke;
  end;

implementation

{ TMulticastEvent }

procedure TMulticastEvent.Add(const AMethod: TEvent);
begin
  FHandlers.Add(TMethod(AMethod))
end;

constructor TMulticastEvent.Create;
begin
  inherited;
  FHandlers := TList<TMethod>.Create;
end;

destructor TMulticastEvent.Destroy;
begin
  ReleaseMethodPointer(FInternalDispatcher);
  FreeAndNil(FHandlers);
  inherited;
end;

function TMulticastEvent.IndexOf(const AMethod: TEvent): Integer;
begin
  result := FHandlers.IndexOf(TMethod(AMethod));
end;

procedure TMulticastEvent.InternalAdd;
asm
  XCHG  EAX,[ESP]
  POP   EAX
  POP   EBP
  JMP   Add
end;

procedure TMulticastEvent.InternalIndexOf;
asm
  XCHG  EAX,[ESP]
  POP   EAX
  POP   EBP
  JMP   IndexOf
end;

procedure TMulticastEvent.InternalInvoke(Params: PParameters; StackSize: Integer);
var
  LMethod: TMethod;
begin
  for LMethod in FHandlers do
  begin
    // Check to see if there is anything on the stack.
    if StackSize > 0 then
      asm
        // if there are items on the stack, allocate the space there and
        // move that data over.
        MOV ECX,StackSize
        SUB ESP,ECX
        MOV EDX,ESP
        MOV EAX,Params
        LEA EAX,[EAX].TParameters.Stack[8]
        CALL System.Move
      end;
    asm
      // Now we need to load up the registers. EDX and ECX may have some data
      // so load them on up.
      MOV EAX,Params
      MOV EDX,[EAX].TParameters.Registers.DWORD[0]
      MOV ECX,[EAX].TParameters.Registers.DWORD[4]
      // EAX is always "Self" and it changes on a per method pointer instance, so
      // grab it out of the method data.
      MOV EAX,LMethod.Data
      // Now we call the method. This depends on the fact that the called method
      // will clean up the stack if we did any manipulations above.
      CALL LMethod.Code
    end;
  end;
end;

procedure TMulticastEvent.InternalRemove;
asm
  XCHG  EAX,[ESP]
  POP   EAX
  POP   EBP
  JMP   Remove
end;

procedure TMulticastEvent.InternalSetDispatcher;
asm
  XCHG  EAX,[ESP]
  POP   EAX
  POP   EBP
  JMP   SetDispatcher;
end;

procedure TMulticastEvent.Remove(const AMethod: TEvent);
begin
  FHandlers.Remove(TMethod(AMethod));
end;

procedure TMulticastEvent.SetDispatcher(var AMethod: TMethod;
  ATypeData: PTypeData);
begin
  if Assigned(FInternalDispatcher.Code) and Assigned(FInternalDispatcher.Data) then
    ReleaseMethodPointer(FInternalDispatcher);
  FInternalDispatcher := CreateMethodPointer(InternalInvoke, ATypeData);
  AMethod := FInternalDispatcher;
end;

{ TMulticastEvent<T> }

procedure TMulticastEvent<T>.Add(const AMethod: T);
begin
  InternalAdd;
end;

constructor TMulticastEvent<T>.Create;
var
  MethInfo: PTypeInfo;
  TypeData: PTypeData;
begin
  MethInfo := TypeInfo(T);
  TypeData := GetTypeData(MethInfo);
  inherited Create;
  Assert(MethInfo.Kind = tkMethod, 'T must be a method pointer type');
  SetEventDispatcher(FInvoke, TypeData);
end;

function TMulticastEvent<T>.IndexOf(const AMethod: T): Integer;
begin
  InternalIndexOf;
end;

procedure TMulticastEvent<T>.Remove(const AMethod: T);
begin
  InternalRemove;
end;

procedure TMulticastEvent<T>.SetEventDispatcher(var ADispatcher: T;
  ATypeData: PTypeData);
begin
  InternalSetDispatcher;
end;

end.
6 голосов
/ 04 августа 2009

Из блога:

То, что делает эта функция, удаляет сам и непосредственный абонент из Цепочка вызовов и прямые переводы управление соответствующим "небезопасным" метод при сохранении переданного в Параметр (ы).

Код исключает кадр стека для InternalAdd, который имеет только один параметр, Self. Он не влияет на событие, которое вы передали, и поэтому безопасно копировать для любой другой функции только с одним параметром и регистр соглашение о вызовах.

РЕДАКТИРОВАТЬ: В ответ на комментарий, есть точка, которую вы упускаете. Когда вы написали: «Я знаю, что делает код (очищает фрейм стека от родительского вызова)», вы ошиблись. Он не касается родительского вызова. Он не очищает кадр стека от Add, он очищает кадр стека от текущего вызова, InternalAdd.

Вот немного базовой теории ОО, так как вы, кажется, немного запутались в этом вопросе, который, я признаю, немного запутывает. Add не действительно имеет один параметр, а SetEventDispatcher не имеет двух. На самом деле их два и три соответственно. Первый параметр любого вызова метода, который не объявлен static , равен Self, и он незаметно добавляется компилятором. Таким образом, каждая из трех внутренних функций имеет один параметр. Вот что я имел в виду, когда писал это.

Код Аллена работает вокруг ограничения компилятора. Каждое событие является указателем на метод, но для обобщений нет «ограничения метода», поэтому компилятор не знает, что T всегда будет 8-байтовой записью, которую можно привести к TMethod. (На самом деле, это не обязательно. Вы можете создать TMulticastEvent<byte>, если вы действительно хотите сломать вашу программу новыми и интересными способами.) Внутренние методы используют ассемблер, чтобы вручную эмулировать типизацию, удаляя себя из полностью вызвать стек и JMPing (в основном GOTO) к соответствующему методу, оставив в нем тот же список параметров, что и у вызывающей его функции.

Итак, когда вы видите 

procedure TMulticastEvent.Add(const AMethod: T);
begin
  InternalAdd;
end;

то, что он делает, эквивалентно следующему, если он будет компилироваться: 

procedure TMulticastEvent.Add(const AMethod: T);
begin
  Add(TEvent(AMethod));
end;

Ваш InternalSetDispatcher захочет сделать то же самое: убрать свой собственный вызов с одним параметром, а затем перейти к SetDispatcher с точно таким же списком параметров, как у вызывающего метода SetEventDispatcher. Не имеет значения, какие параметры имеет вызывающая функция или какая функция используется. Что имеет значение (и это важно!), Так это то, что SetEventDispatcher и SetDispatcher имеют одинаковую подпись вызова друг с другом.

Так что да, гипотетический код, который вы разместили, будет работать нормально и не повредит стек вызовов.

...