获取Allen Bauer的多卡斯特vent<t>工作

在我在Web上运行了很多次之后,答案是汇编程序在调用InternalSetDispatcher时假定存在堆栈帧。

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

因此,修复就如同使用$stack frames on compiler指令打开堆栈帧并重新构建一样简单。

感谢梅森帮助我回答这个问题。:)

编辑2012-0808 :如果您希望使用它,则可能希望在 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.

从博客帖子:

这个函数的作用是删除 自身和来自 呼叫链和直接转移 控制到相应的“不安全” 方法,同时保留传入的 参数(s)。

代码正在消除InternalAdd的堆栈帧,它只有一个参数, Self . 它不会影响您传入的事件,因此可以安全地为只有一个参数和 登记 呼叫约定。

编辑: 作为对评论的回应,有一点你不知道。当你写“我知道代码在做什么(从父调用中清除堆栈帧)”时,你错了。 它不接触父呼叫。 它不是从“添加”中清除堆栈帧,而是从 现在的 调用,内部添加。

这里有一些基本的OO理论,因为你在这一点上似乎有点困惑,我承认这有点困惑。添加不 真的? 有一个参数,setEventDispatcher没有两个。它们实际上分别有两个和三个。未声明的任何方法调用的第一个参数 静止的 是 自我 ,它被编译器无形地添加。所以这三个内部函数都有一个参数。这就是我写的意思。

艾伦的代码所做的工作就是绕过编译器的限制。每个事件都是一个方法指针,但是对于泛型没有“方法约束”,因此编译器不知道T总是一个可以强制转换为t method的8字节记录。(事实上,这不一定是。你可以创建一个 TMulticastEvent<byte> 如果您真的想用新的、有趣的方式破坏您的程序。)内部方法使用assembly手动模拟一个类型转换,方法是完全将自己从调用堆栈中剥离出来,并将jmping(基本上是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具有相同的调用签名。

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