在我在网上跑了很多遍之后，答案是汇编程序假定调用 InternalSetDispatcher 时存在堆栈帧。
似乎没有为调用 InternalSetDispatcher 生成堆栈帧。
因此，修复就像使用 {$stackframes on} 编译器指令打开堆栈帧并重建一样简单。
感谢 Mason 帮助我得到这个答案。 :)
编辑 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.