Подтвердить что ты не робот

Получение работы Allen Bauer TMulticastEvent <T>

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

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

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

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

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

procedure Add(const AMethod: T); overload;

И SetDispatcher имеет два параметра: один var:

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

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

EDIT: просто чтобы уточнить, я ищу ассемблер, который я мог бы использовать, чтобы заставить метод InternalSetDispatcher работать, т.е. ассемблер для очистки стека процедуры с двумя параметрами, один из var.

EDIT2: Я немного изменил вопрос, спасибо Мейсону за его ответы до сих пор. Я должен упомянуть, что приведенный выше код не работает, и когда SetEventDispatcher возвращается, AV поднимается.

4b9b3361

ОТВЕТЫ

Ответ 1

Ответ, после того, как я много работал в Интернете, заключается в том, что ассемблер предполагает, что при вызове 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.

Ответ 2

Из сообщения в блоге:

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

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

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

Здесь немного базовой теории ОО, так как вы, кажется, немного смущены в этом вопросе, что, я признаю, немного запутанно. Добавить не имеет одного параметра, а 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 имеют одну и ту же сигнатуру вызова, как и другие.

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