Delphi 获得艾伦·鲍尔'；s TMulticastEvent<；T>；工作

我一直在研究Allen Bauer的通用多播事件调度器代码（参见他的博客文章）

他提供了足够的代码让我想使用它，不幸的是，他还没有发布完整的源代码。我曾尝试过让它工作，但我的汇编技能是不存在的

我的问题是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);

因此，我假设堆栈会损坏。我知道代码在做什么（通过弹出对self的隐藏引用来清除对InternalSetDispatcher的调用中的堆栈帧，并假设返回地址），但我就是想不出一点汇编程序来完成整个过程

编辑：我只是想澄清一下，我要找的是可以用来让InternalSetDispatcher方法工作的汇编程序，也就是说，用两个参数清理过程堆栈的汇编程序，一个参数是var

EDIT2：我对这个问题做了一点修改，谢谢梅森迄今为止的回答。我应该提到，上面的代码不起作用，当SetEventDispatcher返回时，会引发一个AV。

来自博客：

这个函数的作用是删除 自身和来自的直接调用方 呼叫链和直接传输 控制到相应的“不安全” 方法，同时保留传入的 参数

代码正在删除InternalAdd的堆栈帧，它只有一个参数，

Self

。它对传入的事件没有影响，因此可以安全地复制任何其他函数，只使用一个参数和寄存器调用约定

编辑：对于评论，您缺少一点。当您编写“我知道代码在做什么（清除父调用中的堆栈帧）”时，您错了它不接触父调用。它不是从Add清除堆栈帧，而是从当前调用InternalAdd清除堆栈帧

这里有一点基本的OO理论，因为在这一点上你似乎有点困惑，我承认这有点困惑。Add实际上没有一个参数，SetEventDispatcher也没有两个参数。它们实际上分别有两个和三个。任何方法调用中未声明的static的第一个参数是

Self

，它是由编译器不可见地添加的。所以这三个内部函数都有一个参数。这就是我写这篇文章的意思

Allen的代码所做的是绕过编译器的限制。每个事件都是一个方法指针，但泛型没有“方法约束”，因此编译器不知道t总是一个8字节的记录，可以转换为TMethod。（事实上，不必如此。如果你真的想以新的有趣的方式破坏你的程序，你可以创建一个

TMulticastEvent

）。内部方法使用assembly来手动模拟类型转换，方法是将自己完全从调用堆栈中剥离出来，然后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彼此具有相同的调用签名（这一点很关键）

---

因此，是的，您发布的假设代码可以正常工作，并且不会损坏调用堆栈。

在我在web上运行了很多次之后，答案是汇编器在调用InternalSetDispatcher时假设存在堆栈帧

似乎没有为调用InternalSetDispatcher生成堆栈帧

因此，修复就像使用{$stackframes on}编译器指令打开堆栈帧并重新生成一样简单

谢谢梅森帮我找到这个答案。：）

---

编辑2012-08-08：如果您热衷于使用此功能，您可能希望查看中的实现。我还没有测试过它，但它似乎比这段代码更好地处理不同的调用约定

---

编辑：根据要求，我对艾伦代码的解释如下。除了需要启用堆栈框架外，我还需要在项目级别启用优化，这样才能工作：

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.

unitmulticastevent；
接口
使用
类、SysUtils、泛型、集合、ObjAuto、TypInfo；
类型
//为此，还必须在项目选项中启用优化
//工作！不知道为什么。
{$stackframes on}
{$ifopt O-}
{$message Fatal'optimization}必须打开此单元才能工作！'
{$endif}
TMulticastEvent=类
严格保护
TEvent类型=对象的程序；
严格保密
操作人员：TList；
FInternalDispatcher:TMethod；
过程InternalInvoke（参数：PParameters；堆栈大小：Integer）；
过程SetDispatcher（var-method:TMethod；ATypeData:PTypeData）；
程序新增（施工方法：TEvent）；超载；
程序移除（const-method:TEvent）；超载；
函数IndexOf（const-method:TEvent）：整数；超载；
受保护的
程序内部添加；
程序删除；
程序内部索引；
程序