Getting Allen Bauer's TMulticastEvent<T> working

Question

I've been mucking around with Allen Bauer's code for a generic multicast event dispatcher (see his blog posts about it here).

He gives just enough code to make me want to use it, and unfortunately he hasn't posted the full source. I had a bash at getting it to work, but my assembler skills are non-existent.

My problem is the InternalSetDispatcher method. The naive approach is to use the same assembler as for the other InternalXXX methods:

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

But this is used for procedures with one const parameter, like this:

procedure Add(const AMethod: T); overload;

And SetDispatcher has two parameters, one a var:

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

So, I assume that the stack would get corrupted. I know what the code is doing (cleaning up the stack frame from the call to InternalSetDispatcher by popping the hidden reference to self and I assume the return address), but I just can't figure out that little bit of assembler to get the whole thing going.

EDIT: Just to clarify, what I am looking for is the assembler that I could use to get the InternalSetDispatcher method to work, ie, the assembler to cleanup the stack of a procedure with two parameters, one a var.

EDIT2: I've amended the question a little, thank you to Mason for his answers so far. I should mention that the code above does not work, and when SetEventDispatcher returns, an AV is raised.

Bromal

Edited my answer to give a better explanation of what's going on under the hood. – Prototherian

So, I think I need to re-ask the question... The parameter list is not the problem (thank you Mason), there's something else wrong. Do I delete this question and start fresh? Or do I change the question entirely, making Mason's replies seem odd? – Bromal

It would probably be better to ask another question. – Prototherian

How about posting it so not everybody has to do the same amount of mucking about to get it working. I wish Allan had posted a .zip. – Gonocyte

Done. I've appended it to my answer below – Bromal

This is so incredibly awesome, Thanks Nat! – Gonocyte

No problems Warren! :) Actually, your post has reminded me that there is an implementation of this in the Delphi Spring Framework, and although I haven't tested it, it seems to take into account different calling conventions better than this code... I'm updating my answer to that effect. – Bromal

Answer 1

The answer, after I have done a lot of running around on the web, is that the assembler assumes that a stack frame is present when calling in to InternalSetDispatcher.

It seems that a stack frame was not being generated for the call to InternalSetDispatcher.

So, the fix is as easy as turning on stack frames with the {$stackframes on} compiler directive and rebuilding.

Thanks Mason for your help in getting me to this answer. :)

---

Edit 2012-08-08: If you're keen on using this, you might want to check out the implementation in the Delphi Sping Framework. I haven't tested it, but it looks like it handles different calling conventions better than this code.

---

Edit: As requested, my interpretation of Alan's code is below. On top of needing stack frames turned on, I also needed to have optimization turned on at the project level for this to work:

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.

Bromal

Can you translate procedure TMulticastEvent.InternalInvoke for Win64 ? – Twenty

@ChauCheeYang As I have said above, you should use the multicast event in the Delphi Spring Framework as it already works in Win64. – Bromal

I can provide you with a version for win64. github.com/JensBorrisholt/OnlineOffline – Creaky

Answer 2

From the blog post:

What this function does is removes itself and the immediate caller from the call chain and directly transfers control to the corresponding "unsafe" method while retaining the passed in parameter(s).

The code is eliminating the stack frame for InternalAdd, which only has one parameter, Self. It has no affect on the event you passed in, and so it's safe to copy for any other function with only one parameter and the register calling convention.

EDIT: In response to the comment, there's a point you're missing. When you wrote, "I know what the code is doing (cleaning up the stack frame from the parent call)," you were mistaken. It does not touch the parent call. It's not cleaning up the stack frame from Add, it's cleaning up the stack frame from the current call, InternalAdd.

Here's a bit of basic OO theory, since you seem to be a little confused on this point, which I'll admit is a little confusing. Add doesn't really have one parameter, and SetEventDispatcher doesn't have two. They actually have two and three, respectively. The first parameter of any method call that's not declared static is Self, and it's added invisibly by the compiler. So the three Internal functions each have one parameter. That's what I meant when I wrote that.

What Allen's code is doing is working around a compiler limitation. Every event is a method pointer, but there's no "method constraint" for generics, so the compiler doesn't know that T is always going to be an 8-byte record that can be cast to a TMethod. (In fact, it doesn't have to be. You could create a TMulticastEvent<byte> if you really wanted to break your program in new and interesting ways.) The internal methods use assembly to manually emulate a typecast by stripping themselves out of the call stack completely and JMPing (basically a GOTO) to the appropriate method, leaving it with the same parameter list as the function that called it had.

So when you see

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

what it's doing is equivalent to the following, if it would compile:

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

Your InternalSetDispatcher will want to do exactly the same thing: strip its own one-parameter call out, and then jump to SetDispatcher with exactly the same parameter list as the calling method, SetEventDispatcher, had. It doesn't matter what parameters the calling function has, or the function that it's jumping to. What does matter (and this is critical!) is that SetEventDispatcher and SetDispatcher have the same call signature as each other.

So yes, the hypothetical code you posted will work just fine and it won't corrupt the call stack.

Prototherian

Indeed! :) And it works for those functions you have described. What I was hoping for was the assembler for a function with two parameters, one a var. – Bromal

Thanks for your response... I understand all the OOP stuff, with the hidden parameter (self), I also understand that it's the call to InternalXXX that is being removed from the stack (I will amend my question to make it less confusing). The only problem I can see with your answer (which is great BTW) is that the code in fact doesn't work. When the SetEventDispatcher returns, it jumps off to la-la-land, resulting in an AV. So from that I surmise that there is something wrong and the stack is indeed being corrupted or the return address is broken. – Bromal

Could the problem be (I think) that the var parameter is not being passed back up? – Bromal

Ah! Of course, I am an idiot, the var doesn't matter, it is simply a pointer to the value, rather than the value itself... – Bromal