In using a proposed multicast delegate approach in response to the Signals and slots implementation in Delphi question, the code fails to add more than one event handler.
The problem is related to adding methods to the event list in TDelegateImpl<T>.Add()
, the TList<T>.IndexOf
method uses a Compare method to find existing methods and the result is always 0 - meaning Left and Right is the same for a TMethod. The Equals method uses a TMethod
type cast and explicitly compares TMethod.Code
and TMethod.Data
, where Compare
casts to an address which is always the same.
Why is Compare
used in TList<T>.IndexOf
and not Equals
?
The problem is this function:
function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
begin
if PInt64(@Left)^ < PInt64(@Right)^ then
Result := -1
else if PInt64(@Left)^ > PInt64(@Right)^ then
Result := 1
else
Result := 0;
end;
This compares methods as Int64s. That doesn't work, since @ probably has no effect here.
The CPU view confirms this:
System.Generics.Defaults.pas.1089: begin
00447690 55 push ebp
00447691 8BEC mov ebp,esp
System.Generics.Defaults.pas.1090: if PInt64(@Left)^ < PInt64(@Right)^ then
00447693 8B4510 mov eax,[ebp+$10]
00447696 8B5004 mov edx,[eax+$04]
00447699 8B00 mov eax,[eax]
0044769B 8B4D08 mov ecx,[ebp+$08]
0044769E 3B5104 cmp edx,[ecx+$04]
004476A1 7506 jnz $004476a9
004476A3 3B01 cmp eax,[ecx]
004476A5 7309 jnb $004476b0
004476A7 EB02 jmp $004476ab
004476A9 7D05 jnl $004476b0
System.Generics.Defaults.pas.1091: Result := -1
004476AB 83C8FF or eax,-$01
004476AE EB21 jmp $004476d1
System.Generics.Defaults.pas.1092: else if PInt64(@Left)^ > PInt64(@Right)^ then
004476B0 8B4510 mov eax,[ebp+$10]
etc...
To compare two TMethods as Int64s, this should be:
System.Generics.Defaults.pas.1090: if PInt64(@Left)^ < PInt64(@Right)^ then
00447693 8B4510 lea eax,[ebp+$10] // not MOV
00447696 8B5004 mov edx,[eax+$04]
00447699 8B00 mov eax,[eax]
0044769B 8B4D08 lea ecx,[ebp+$08] // not MOV
0044769E 3B5104 cmp edx,[ecx+$04]
004476A1 7506 jnz $004476a9
004476A3 3B01 cmp eax,[ecx]
etc...
This clearly shows that PInt64(@Left)^
is interpreted as PInt64(Left)^
.
A proper implementation should more or less look like this, for both Delphi 32 and Delphi 64:
function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
var
LCode, LData: PByte;
RCode, RData: PByte;
begin
LCode := PByte(TMethod(Left).Code);
LData := PByte(TMethod(Left).Data);
RCode := PByte(TMethod(Right).Code);
RData := PByte(TMethod(Right).Data);
if LData < RData then
Result := -1
else if LData > RData then
Result := 1
else if LCode < RCode then
Result := -1
else if LCode > RCode then
Result := 1
else
Result := 0;
end;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With