让Allen Bauer的TMulticastEvent<T>正常工作

Question

我一直在研究Allen Bauer的通用多播事件调度器代码（请参见他关于此的博客文章here）。他提供的代码足够让我想要使用它，但不幸的是他没有发布完整的源代码。我试图让它工作，但我的汇编技能非常有限。

我的问题出现在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);

所以，我假设堆栈会被破坏。我知道代码在做什么（通过弹出对self的隐藏引用和我假设的返回地址来清理调用InternalSetDispatcher的堆栈帧），但我只是不能想出那个汇编程序的小细节，以使整个过程正常运行。

编辑：为了澄清，我要找的是汇编程序，以便让InternalSetDispatcher方法工作，即清除具有两个参数（一个是var）的过程的堆栈的汇编程序。

编辑2：我稍微修改了问题，感谢Mason迄今为止的答案。我应该提到上面的代码不起作用，当SetEventDispatcher返回时，会引发AV异常。

- Nat

---

编辑我的答案以更好地解释底层发生的情况。 - Mason Wheeler

所以，我认为我需要重新提出问题...参数列表不是问题（谢谢Mason），还有其他的问题。我应该删除这个问题并重新开始吗？还是我要完全改变问题，让Mason的回答看起来很奇怪？ - Nat

最好还是问另一个问题。 - Mason Wheeler

这太棒了，谢谢 Nat！ - Warren P

没问题，沃伦！ :) 其实，你的帖子提醒了我 Delphi Spring Framework 中有一个实现，虽然我还没有测试过，但它似乎比这段代码更好地考虑了不同的调用约定... 我正在更新我的答案。 - Nat

Answer 1

经过我在网上的大量搜索，答案是汇编器在调用InternalSetDispatcher时假定存在堆栈帧。

似乎在调用InternalSetDispatcher时没有生成堆栈帧。

因此，修复方法很简单，只需使用{$stackframes on}编译器指令打开堆栈帧并重新构建即可。

感谢Mason帮助我找到这个答案。 :)

---

编辑2012-08-08：如果您想使用此代码，您可能需要查看Delphi Sping Framework中的实现。虽然我没有测试过，但它看起来比这段代码更好地处理了不同的调用约定。

---

编辑：根据要求，以下是我对Alan代码的解释。除了需要打开堆栈帧之外，还需要在项目级别打开优化才能使其正常工作：

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.

- Nat

---

你能翻译一下Win64下的procedure TMulticastEvent.InternalInvoke吗？ - Chau Chee Yang

@ChauCheeYang 正如我之前所说，你应该在Delphi Spring Framework中使用多播事件，因为它已经在Win64上运行良好。 - Nat

我可以为您提供win64版本。https://github.com/JensBorrisholt/OnlineOffline - Jens Borrisholt

Answer 2

从博客文章中可以看出，这个函数的作用是将自身和直接调用者从调用链中移除，并直接转移到相应的“不安全”方法，同时保留传入的参数。代码消除了InternalAdd的堆栈帧，该函数只有一个名为Self的参数。它对传入的事件没有影响，因此可以在任何只有一个参数和寄存器调用约定的其他函数中安全地复制。需要注意的是，这段代码并没有触及父调用的堆栈帧，而是清除了当前调用InternalAdd的堆栈帧。由于泛型没有“方法约束”，所以编译器不知道T始终将是一个可以转换为TMethod的8字节记录。内部方法使用汇编语言手动模拟类型转换，通过完全剥离自己的调用堆栈并JMP（基本上是GOTO）到适当的方法来实现，使其保持与调用它的函数相同的参数列表。

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

它所做的等同于以下代码（如果它可以编译通过）：

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

你的InternalSetDispatcher希望做的事情与此完全相同：去掉自己的单参数调用，然后使用与调用方法SetEventDispatcher完全相同的参数列表跳转到SetDispatcher。调用函数或跳转函数具有什么参数并不重要。重要的是（这一点至关重要！）SetEventDispatcher和SetDispatcher具有相同的调用签名。

所以，是的，你贴出的假设代码将完美地工作，并且不会损坏调用堆栈。

- Mason Wheeler

---

确实！ :) 它适用于您所描述的那些函数。我希望得到的是一个具有两个参数的函数的汇编程序，其中一个是变量。 - Nat

感谢您的回复...我理解所有OOP的东西，包括隐藏的参数（self），我也明白从堆栈中删除的是对InternalXXX的调用（我会修改我的问题使其更少混淆）。我能看到您的答案唯一的问题（顺便说一句，非常好），那就是代码实际上并不起作用。当SetEventDispatcher返回时，它跳转到la-la-land，并导致AV错误。因此，我推断出有什么问题，堆栈确实被破坏了，或者返回地址已经损坏了。 - Nat

问题可能是（我认为）var参数没有被传回上层？ - Nat

啊！当然，我是个傻瓜，变量并不重要，它只是一个指向值的指针，而不是值本身... - Nat