Под капотом published методов

Это перевод Under the hood of published methods. Автор: Hallvard Vassbotn.

Теперь, когда я рассказал, что такое published методы, как IDE и VCL используют их при сохранении/загрузке .DFM и как использовать их полиморфно, мы готовы погрузиться глубже в их детали реализации под капотом языка.

Если вы следовали за мной через эту серию постов о полиморфных возможностях языка Delphi, то вы уже заметили, что VMT классов содержит поле MethodTable, которое мы пока определили как нетипизированный указатель (Pointer). После тщательного анализа методов TObject, работающих с этой таблицей (MethodName и MethodAddress), мне удалось написать приблизительное объявление структуры MethodTable на Pascal-е:

type
  PPublishedMethod = ^TPublishedMethod;
  TPublishedMethod = packed record
    Size: word;  
    Address: Pointer;
    Name: {packed} ShortString; // на самом деле string[Length(Name)]
  end;
  TPublishedMethods = packed array[0..High(Word)-1] of TPublishedMethod;
  PPmt = ^TPmt;
  TPmt = packed record
    Count: Word;
    Methods: TPublishedMethods; // на самом деле [0..Count-1]
  end;
 
  PVmt = ^TVmt;
  TVmt = packed record
    // …
    MethodTable       : PPmt;
    // …
  end;

Как вы можете видеть выше, таблица published методов теперь имеет тип PPmt. Это указатель на запись, которая содержит число published методов в классе, за которым следует массив из этого количества записей TPublishedMethod. Каждая запись содержит размер (используется для перехода к следующему элементу), указатель на точку входа метода и ShortString, содержащую имя метода.

Заметьте, что поле Size избыточно: во всех случаях значение Size равно:

Size :=  SizeOf(Size) + SizeOf(Address) + SizeOf(Name[0]) + Length(Name);

Другими словами, следующая запись TPublishedMethod начинается прямо за последним байтом текущей записи (т.е. последним байтом имени метода). Я не уверен, почему Borland решила добавить поле Size, но возможной причиной может быть расширение записи TPublishedMethod в будущем. Естественное расширение - добавить информацию по количеству и типам параметров, а также соглашению вызова метода. Тогда поле Size было бы увеличено, а старый код, который не в курсе новых возможностей, продолжал работать бы дальше (см. также заметку о дополнительных данных published методов в конце поста).

Теперь, когда у нас есть структуры данных для работы, давайте напишем несколько вспомогательных подпрограмм:

function GetVmt(AClass: TClass): PVmt;
begin
  Result := PVmt(AClass);
  Dec(Result);
end;
 
function GetPmt(AClass: TClass): PPmt;
var
  Vmt: PVmt;
begin
  Vmt := GetVmt(AClass);
  if Assigned(Vmt) then 
    Result := Vmt.MethodTable
  else 
    Result := nil;
end;
 
function GetPublishedMethodCount(AClass: TClass): integer;
var
  Pmt: PPmt;
begin
  Pmt := GetPmt(AClass);
  if Assigned(Pmt) then
    Result := Pmt.Count
  else
    Result := 0;
end;
 
function GetPublishedMethod(AClass: TClass; Index: integer): PPublishedMethod;
var
  Pmt: PPmt;
begin
  Pmt := GetPmt(AClass);
  if Assigned(Pmt) and (Index < Pmt.Count) then
  begin
    Result := @Pmt.Methods[0];
    while Index > 0 do
    begin
      Inc(PChar(Result), Result.Size);
      Dec(Index);
    end;
  end
  else
    Result := nil;
end;

Сначала мы просим нашего старого друга GetVmt получить указатель на волшебную часть VMT по ссылке на данный класс. Используя это и новый тип PPmt, мы можем написать функцию GetPmt выше - она возвращает указатель на таблицу published методов класса. Затем, есть две подпрограммы, которые возвращают число published методов и заданный published метод по индексу от 0 до Count - 1. Используя эти служебные подпрограммы, мы можем написать тестовый код для дампа всех published методов класса (и его родительских классов).

procedure DumpPublishedMethods(AClass: TClass);
var
  i : integer;
  Method: PPublishedMethod;
begin
  while Assigned(AClass) do
  begin
    WriteLn('Published methods in ', AClass.ClassName);
    for i := 0 to GetPublishedMethodCount(AClass)-1 do
    begin
      Method := GetPublishedMethod(AClass, i);
      WriteLn(Format('%d. MethodAddr = %p, Name = %s', [i, Method.Address, Method.Name]));
    end;
    AClass := AClass.ClassParent;
  end;
end;

Этот код дампа работает отлично, но его производительность далека от идеальной. Методу GetPublished приходится делать поиск заново для каждого значения Index, что даёт подпрограмме Dump сложность выполнения O(n^2) (где n - это число published методов в классе). Хотя большинство классов не имеют ужасно много published методов и эта работа во внутреннем цикле часто будет минимальной, так что на практике этот момент не должен стать проблемой.

Однако моя одержимость производительностью обязует меня ускорить этот код, хотя бы в теоретическом плане. Массив из записей TPublishedMethod может быть рассмотрен как примитивный односвязный список (singly linked list): произвольный доступ для него является медленным, так что техника итератора должна улучшить производительность. Давайте напишем ещё вспомогательных подпрограмм:

function GetFirstPublishedMethod(AClass: TClass): PPublishedMethod;
begin
  Result := GetPublishedMethod(AClass, 0);
end;
 
function GetNextPublishedMethod(AClass: TClass; PublishedMethod: PPublishedMethod): PPublishedMethod;
begin
  Result := PublishedMethod;
  if Assigned(Result) then
    Inc(PChar(Result), Result.Size);
end;

Эти две подпрограммы являются типичной парой GetFirst/GetNext итераторов. Первый метод возвращает ссылку на первый published метод, а второй метод возвращает ссылку на следующий published метод. Заметьте, что вызывать GetNextPublishedMethod нужное число раз (используя GetPublishedMethodCount) является ответственностью вызывающего. Теперь мы можем переписать метод дампа, делая его немного быстрее:

procedure DumpPublishedMethodsFaster(AClass: TClass);
var
  i : integer;
  Method: PPublishedMethod;
begin
  while Assigned(AClass) do
  begin
    WriteLn('Published methods in ', AClass.ClassName);
    Method := GetFirstPublishedMethod(AClass);
    for i := 0 to GetPublishedMethodCount(AClass) - 1 do
    begin
      WriteLn(Format('%d. MethodAddr = %p, Name = %s', [i, Method.Address, Method.Name]));
      Method := GetNextPublishedMethod(AClass, Method);
    end;
    AClass := AClass.ClassParent;
  end;
end;

Итерация по всем published методам класса или их дамп обычно не очень нужны на практике. TObject уже содержит методы, которые позволяют производить поиск published методов: MethodAddress и MethodName. Они написаны эффективно, на ассемблере, но это также делает их сложнее для чтения и понимания. Я использовал их для определения формата таблицы published методов выше. Вот они же, но уже на Pascal-е:

function FindPublishedMethodByName(AClass: TClass; const AName: ShortString): PPublishedMethod;
var
  i : integer;
begin
  while Assigned(AClass) do
  begin
    Result := GetFirstPublishedMethod(AClass);
    for i := 0 to GetPublishedMethodCount(AClass) - 1 do
    begin
      // Заметьте: Length(ShortString) разворачивается в эффективный inline-код
      if (Length(Result.Name) = Length(AName)) and
         (StrLIComp(@Result.Name[1], @AName[1], Length(AName)) = 0) then
        Exit;
      Result := GetNextPublishedMethod(AClass, Result);
    end;
    AClass := AClass.ClassParent;
  end;
  Result := nil;
end;
 
function FindPublishedMethodByAddr(AClass: TClass; AAddr: Pointer): PPublishedMethod;
var
  i : integer;
begin
  while Assigned(AClass) do
  begin
    Result := GetFirstPublishedMethod(AClass);
    for i := 0 to GetPublishedMethodCount(AClass) - 1 do
    begin
      if Result.Address = AAddr then
        Exit;
      Result := GetNextPublishedMethod(AClass, Result);
    end;
    AClass := AClass.ClassParent;
  end;
  Result := nil;
end;
 
function FindPublishedMethodAddr(AClass: TClass; const AName: ShortString): Pointer;
var
  Method: PPublishedMethod;
begin
  Method := FindPublishedMethodByName(AClass, AName);
  if Assigned(Method) then 
    Result := Method.Address
  else 
    Result := nil;
end;
 
function FindPublishedMethodName(AClass: TClass; AAddr: Pointer): Shortstring;
var
  Method: PPublishedMethod;
begin
  Method := FindPublishedMethodByAddr(AClass, AAddr);
  if Assigned(Method) then
    Result := Method.Name
  else 
    Result := '';
end;

Первые две функции ищут published метод по имени или адресу и возвращают указатель на запись TPublishedMethod, описывающую метод. Иметь прямой доступ к этой записи может оказаться полезным при выполнении другой работы со структурами RTTI. В любом случае, последние две функции возвращают строку и адрес напрямую, соответствуя методам MethodName и MethodAddress.

Наконец, мы можем написать класс для теста подпрограмм, которые мы написали:

type
  {$M+}
  TMyClass = class
  published
    procedure FirstPublished; 
    procedure SecondPublished(A: integer); 
    procedure ThirdPublished(A: integer); stdcall; 
    function FourthPublished(A: TComponent): TComponent; stdcall; 
    procedure FifthPublished(Component: TComponent); stdcall; 
    function SixthPublished(A: string; Two, Three, Four, Five, Six: integer): string; pascal; 
  end;
  
procedure TMyClass.FirstPublished; 
begin 
end;

procedure TMyClass.SecondPublished; 
begin 
end;

procedure TMyClass.ThirdPublished; 
begin 
end;

function TMyClass.FourthPublished;
begin 
  Result := nil;
end;

procedure TMyClass.FifthPublished;
begin
end;

function TMyClass.SixthPublished;
begin 
end;
  
procedure DumpMethod(Method: PPublishedMethod);
begin
  if Assigned(Method) then 
    WriteLn(Format('%p=%s', [Method.Address, Method.Name]))
  else 
    WriteLn('nil');
end;

procedure Test;

begin
  DumpPublishedMethods(TMyClass);
  DumpPublishedMethodsFaster(TMyClass);
  DumpMethod(FindPublishedMethodByName(TMyClass, 'FirstPublished'));
  DumpMethod(FindPublishedMethodByName(TMyClass, FindPublishedMethodName(TMyClass, @TMyClass.SecondPublished)));
  DumpMethod(FindPublishedMethodByAddr(TMyClass, @TMyClass.ThirdPublished));
  DumpMethod(FindPublishedMethodByAddr(TMyClass, FindPublishedMethodAddr(TMyClass, 'FourthPublished')));
  DumpMethod(FindPublishedMethodByAddr(TMyClass, FindPublishedMethodByName(TMyClass, 'FifthPublished').Address));
  DumpMethod(FindPublishedMethodByAddr(TMyClass, @TMyClass.SixthPublished));
  DumpMethod(FindPublishedMethodByName(TMyClass, 'NotThere'));
  DumpMethod(FindPublishedMethodByAddr(TMyClass, nil));
end;
 
begin
  Test;
  ReadLn;
end.

Вывод этого тестового кода:

Published methods in TMyClass
0. MethodAddr = 00412BCC, Name = FirstPublished
1. MethodAddr = 00412BD0, Name = SecondPublished
2. MethodAddr = 00412BD4, Name = ThirdPublished
3. MethodAddr = 00412BDC, Name = FourthPublished
4. MethodAddr = 00412BE8, Name = FifthPublished
5. MethodAddr = 00412BF0, Name = SixthPublished
Published methods in TObject
Published methods in TMyClass
0. MethodAddr = 00412BCC, Name = FirstPublished
1. MethodAddr = 00412BD0, Name = SecondPublished
2. MethodAddr = 00412BD4, Name = ThirdPublished
3. MethodAddr = 00412BDC, Name = FourthPublished
4. MethodAddr = 00412BE8, Name = FifthPublished
5. MethodAddr = 00412BF0, Name = SixthPublished
Published methods in TObject
00412BCC=FirstPublished
00412BD0=SecondPublished
00412BD4=ThirdPublished
00412BDC=FourthPublished
00412BE8=FifthPublished
00412BF0=SixthPublished
nil
nil

Поиск дополнительных данных published методов

Я добавил немного отладочного кода в GetNextPublishedMethod, который пытается найти запись TPublishedMethod, в которой поле Size было бы больше, чем размер полей, включая имя, обсуждаемых выше:

function GetNextPublishedMethod(AClass: TClass; PublishedMethod: PPublishedMethod): PPublishedMethod;
{$IFDEF DEBUG}
var
  ExpectedSize: integer;
{$ENDIF}
begin
  Result := PublishedMethod;
{$IFDEF DEBUG}
  ExpectedSize :=   SizeOf(Result.Size) 
                  + SizeOf(Result.Address) 
                  + SizeOf(Result.Name[0]) 
                  + Length(Result.Name);
  if Result.Size <> ExpectedSize then
    raise Exception.CreateFmt('RTTI for the published method "%s" of class "%s" has %d extra bytes of unknown data!', [Result.Name, AClass.ClassName, Result.Size-ExpectedSize]);
{$ENDIF}
  if Assigned(Result) then
    Inc(PChar(Result), Result.Size);
end;

Во время моего тестирования published методов различных соглашений вызова и числа параметров, мне так и не удалось найти ни одного случая с дополнительными данными. Дайте мне знать, если вам это удастся. Прим.пер.: вообще-то, дополнительные данные генерируются при включении т.н. расширенной RTTI информации класса - о чём сам же Hallvard говорит позднее в продолжении серии.

Я смутно вспомнил, что Ray Lischner писал об этих дополнительных полях в своей замечательной книге "Delphi in a Nutshell". Фактически, я был одним из технических редакторов этой книги - так что я должен помнить :-) Как пишет Ray (см. стр. 74), Delphi 5 (и более ранние версии) будут кодировать параметры некоторых published методов - точнее методов stdcall, у которых параметры и возвращаемое значение имеют RTTI-информацию. Это половинчатое решение по кодированию параметров, видимо, является остатком каких-то экспериментальных версий RTTI кода в компиляторе, которые, кажется, были удалены из Delphi 7 и выше.