Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Default Generic Comparer for methods returns incorrect results

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?

like image 495
MX4399 Avatar asked Sep 15 '11 08:09

MX4399


1 Answers

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;
like image 186
Rudy Velthuis Avatar answered Nov 13 '22 09:11

Rudy Velthuis