Детали реализации published полей

Это перевод Published fields details. Автор: Hallvard Vassbotn.

В предыдущей статье мы посмотрели на то, как published поля используются IDE и VCL, чтобы сделать простыми работу с компонентными ссылками и нахождение классовых ссылок по именам типов. Сейчас мы заглянем глубже в детали реализации published полей.

Начав с анализа ассемблерного кода TObject.FieldAddress, мне удалось реконструировать примерный вид внутренних структур на Pascal-е:

type
  TPublishedField = packed record
    Offset: Integer;
    Filler: word;  // ??
    Name: {packed} Shortstring; // в действительности string[Length(Name)]
  end;

  PPft = ^TPft;
  TPft = packed record
    Count: Word;
    Filler: LongWord; // ??
    Fields: array[0..High(Word)-1] of TPublishedField; // в действительности [0..Count-1]
  end;
  
  PVmt = ^TVmt;
  TVmt = packed record
    // ...
    FieldTable        : PPft;
    // ...
  end;

Поле FieldTable в записи TVmt, которую мы разбирали ранее, теперь стало более конкретизированным: типа PPft - указателем на таблицу published полей. Pft начинается с 2-байтового поля - счётчика элементов, за которыми идёт 4 неизвестных мне байта (они пропускаются функцией TObject.FieldAddress), после которых расположен массив переменной длины из записей типа TPublisedField. Как и в прочих структурах RTTI, поля типа ShortString упакованы до их реальной длины, поэтому все записи имеют переменный размер. Запись TPublishedField включает в себя поле Offset - смещение поля от начала экземпляра объекта, 2 байта неизвестных данных, а также ShortString с именем класса поля. Мы скоро разберёмся с этими неизвестными данными.

К счастью, функция GetFieldClassTable в секции implementation модуля Classes (которую мы обсуждали в предыдущем посте), явно указывает, что поле Filler записи TPft указывает на список классов. Имея на руках эту информацию, мы можем обновить наши определения выше:

type
  PClass  = ^TClass;

  PPublishedFieldTypes = ^TPublishedFieldTypes;
  TPublishedFieldTypes = packed record
    TypeCount: word;
    Types: array[0..High(Word)-1] of PClass; // на самом деле: [0..TypeCount-1]
  end;

  TPft = packed record
    Count: Word;
    FieldTypes: PPublishedFieldTypes;
    Fields: TPublishedFields; // на самом деле: [0..Count-1]
  end;

Теперь мы идентифицировали поле FieldTypes, которое указывает на запись со счётчиком TypeCount и массивом ссылок на классы. Заметьте, что ссылки на классы имеют дополнительный уровень косвенности. TClass сам по себе является указателем, но массив, фактически, содержит указатели, которые указывают на ссылки TClass. Причина подобной конструкции "ссылка на ссылку на класс" заключается в поддержке RTTI информации и VMT TClass, которые находятся в другом исполняемом модуле (случай с пакетами - BPL packages). Мы видим, что подобное же косвенное указание через дополнительный указатель используется в модуле TypInfo для указателей PTypeInfo, в реализации глобальных переменных, а также полях InstanceSize и Parent TVmt. Код поддержки пакетов в Delphi, генерируемый компоновщиком (linker) автоматически исправляет эти указатели после загрузки статически связанных пакетов.

У нас пока осталось неизвестное поле в записи TPublishedField. Когда я только начал писать тестовый код и делать дамп таблицы полей из выбранных классов тестового кода, мне показалось, что там использовалась последовательная индексация с нуля. Но когда я добавил ещё одно published поле типа TObject, нового элемента не появилось. Хммм. Добавив сюда отсутствующую связь с массивом FieldTypes, я быстро сообразил, что неизвестное поле в TPublishedField было индексом типа в массиве ссылок на классы.

Это подтверждается тем, что массив FieldTypes содержит только уникальные ссылки на классы. Если у вас есть 10 published полей типа TLabel, у вас будет только одна ссылка на TLabel в массиве FieldTypes. Для больших форм, где есть много компонентов, но нет разнообразия их типов, это экономит немного места в записи TPublishedField - каждый индекс занимает 2 байта, а ссылка на TClass - 4. Что более важно, массив FieldTypes теперь может быть использован, чтобы быстро транслировать имя в ссылку, не тратя время на сканирование таблицы.

После опознания назначения всех полей, у нас теперь есть такие объявления типов:

type
  PClass  = ^TClass;

  PPublishedField = ^TPublishedField;
  TPublishedField = packed record
    Offset: Integer;
    TypeIndex: word;  // Индекс в массиве FieldTypes ниже
    Name: {packed} Shortstring; // string[Length(Name)]
  end;

  PPublishedFieldTypes = ^TPublishedFieldTypes;
  TPublishedFieldTypes = packed record
    TypeCount: word;
    Types: array[0..High(Word)-1] of PClass; // [0..TypeCount-1]
  end;
  TPublishedFields = packed array[0..High(Word)-1] of TPublishedField;

  PPft = ^TPft;
  TPft = packed record
    Count: Word;
    FieldTypes: PPublishedFieldTypes;
    Fields: TPublishedFields; // [0..Count-1]
  end;

Не считая массива FieldTypes и поля TypeIndex, эти структуры выглядят весьма похоже на RTTI структуры published методов. Чтобы быстро собрать подпрограммы-утилиты для работы с этими структурами, я использовал народные методы copy-and-paste и search-and-replace:

function GetPft(AClass: TClass): PPft;
var
  Vmt: PVmt;
begin
  Vmt := GetVmt(AClass);
  if Assigned(Vmt) then 
    Result := Vmt.FieldTable
  else 
    Result := nil;
end;
 
function GetPublishedFieldCount(AClass: TClass): integer;
var
  Pft: PPft;
begin
  Pft := GetPft(AClass);
  if Assigned(Pft) then
    Result := Pft.Count
  else
    Result := 0;
end;

Загадочно названная функция GetPft возвращает указатель на таблицу published полей по данной ей ссылке на класс. Она использует функцию GetVmt для получения указателя на "волшебную" часть таблицы виртуальных методов (VMT), а затем просто возвращает значение поля FieldTable. Функция GetPublishedFieldCount возвращает число published полей по ссылке на класс (не считая полей предков класса).

Функции для итерации по таблице published полей класса, используя как индексный доступ, так и итераторы, также конвертируются без проблем:

function GetNextPublishedField(AClass: TClass; PublishedField: PPublishedField): PPublishedField;
begin
  Result := PublishedField;
  if Assigned(Result) then
    Inc(PChar(Result),   SizeOf(Result.Offset)
                       + SizeOf(Result.TypeIndex)
                       + SizeOf(Result.Name[0])
                       + Length(Result.Name));
end;

function GetPublishedField(AClass: TClass; TypeIndex: integer): PPublishedField;
var
  Pft: PPft;
begin
  Pft := GetPft(AClass);
  if Assigned(Pft) and (TypeIndex < Pft.Count) then
  begin
    Result := @Pft.Fields[0];
    while TypeIndex > 0 do
    begin
      Result := GetNextPublishedField(AClass, Result);
      Dec(TypeIndex);
    end;
  end
  else
    Result := nil;
end;

function GetFirstPublishedField(AClass: TClass): PPublishedField;
begin
  Result := GetPublishedField(AClass, 0);
end;

Единственное отличие здесь - запись TPublishedField не содержит явного поля размера (как это было в случае с TPublishedMethod). Вместо этого нам приходится самим вычислять размер элемента, путём сложения размера фиксированной части с переменным размером поля имени, чтобы перемещать текущую позицию к следующей записи в массиве. И снова, как и ранее, ответственность за нужное количество вызовов GetNextPublishedField лежит на вызывающем (используя GetPublishedFieldCount).

Затем мы вводим подпрограммы поиска, которые находит заданное published поле по признакам вроде имени поля, смещению поля или его адресу. Эти подпрограммы используют функции итерации, приведённые выше. При успехе они возвращают указатель на соответствующую запись TPublishedField из RTTI информации, при ошибке же они возвращают nil:

function FindPublishedFieldByName(AClass: TClass; const AName: ShortString): PPublishedField;
var
  i : integer;
begin
  while Assigned(AClass) do
  begin
    Result := GetFirstPublishedField(AClass);
    for i := 0 to GetPublishedFieldCount(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 := GetNextPublishedField(AClass, Result);
    end;
    AClass := AClass.ClassParent;
  end;
  Result := nil;
end;

function FindPublishedFieldByOffset(AClass: TClass; AOffset: Integer): PPublishedField;
var
  i : integer;
begin
  while Assigned(AClass) do
  begin
    Result := GetFirstPublishedField(AClass);
    for i := 0 to GetPublishedFieldCount(AClass) - 1 do
    begin
      if Result.Offset = AOffset then
        Exit;
      Result := GetNextPublishedField(AClass, Result);
    end;
    AClass := AClass.ClassParent;
  end;
  Result := nil;
end;

function FindPublishedFieldByAddr(Instance: TObject; AAddr: Pointer): PPublishedField;
begin
  Result := FindPublishedFieldByOffset(Instance.ClassType, PChar(AAddr) - PChar(Instance));
end;

Прямая работа с записями TPublishedField достаточно трудоёмка, поэтому я также написал несколько функций-оболочек (wrappers), которые просто возвращают информацию напрямую по данной им ссылке на класс:

function FindPublishedFieldOffset(AClass: TClass; const AName: ShortString): integer;
var
  Field: PPublishedField;
begin
  Field := FindPublishedFieldByName(AClass, AName);
  if Assigned(Field) then
    Result := Field.Offset
  else
    Result := -1;
end;

function FindPublishedFieldAddr(Instance: TObject; const AName: ShortString): PObject;
var
  Offset: integer;
begin
  Offset := FindPublishedFieldOffset(Instance.ClassType, AName);
  if Offset >= 0 then
    Result := PObject(PChar(Instance) + Offset)
  else
    Result := nil;
end;

function FindPublishedFieldName(AClass: TClass; AOffset: integer): ShortString; overload;
var
  Field: PPublishedField;
begin
  Field := FindPublishedFieldByOffset(AClass, AOffset);
  if Assigned(Field) then
    Result := Field.Name
  else
    Result := '';
end;

function FindPublishedFieldName(Instance: TObject; AAddr: Pointer): ShortString; overload;
var
  Field: PPublishedField;
begin
  Field := FindPublishedFieldByAddr(Instance, AAddr);
  if Assigned(Field) then
    Result := Field.Name
  else
    Result := '';
end;

Наконец, я написал подпрограммы для возврата типа, адреса и значения published поля по имеющемуся у вас на руках указателю на TPublishedField. Они пригодятся, если вы будете писать свои собственные функции по работе с published полями класса:

function GetPublishedFieldType(AClass: TClass; Field: PPublishedField): TClass;
var
  Pft: PPft;
begin
  Pft := GetPft(AClass);
  if Assigned(Pft) and Assigned(Field) and (Field.TypeIndex < Pft.FieldTypes.TypeCount) then
    Result := Pft.FieldTypes.Types[Field.TypeIndex]^
  else
    Result := nil;
end;

function GetPublishedFieldAddr(Instance: TObject; Field: PPublishedField): PObject;
begin
  if Assigned(Field) then
    Result := PObject(PChar(Instance) + Field.Offset)
  else
    Result := nil;
end;

function GetPublishedFieldValue(Instance: TObject; Field: PPublishedField): TObject;
var
  FieldAddr: PObject;
begin
  FieldAddr := GetPublishedFieldAddr(Instance, Field);
  if Assigned(FieldAddr) then
    Result := FieldAddr^
  else
    Result := nil;
end;

Фух! Куча однообразного и скучного кода. Но теперь мы можем написать функцию, которая дампит информацию о published полях класса, реконструируя его объявление:

procedure DumpPublishedFields(AClass: TClass); overload;
var
  i : integer;
  Count: integer;
  Field: PPublishedField;
  FieldType: TClass;
  ParentClass: string;
begin
  while Assigned(AClass) do
  begin
    Count := GetPublishedFieldCount(AClass);
    if Count > 0 then
    begin
      if AClass.ClassParent <> nil then
        ParentClass := '(' + AClass.ClassParent.ClassName + ')'
      else
        ParentClass := '';
      WriteLn('type');
      WriteLn('  ', AClass.ClassName, ' = class', ParentClass);
      WriteLn('  published');

      Field := GetFirstPublishedField(AClass);
      for i := 0 to Count-1 do
      begin
        FieldType  := GetPublishedFieldType(AClass, Field);
        WriteLn(Format('    %s: %s; // Offs=%d, Index=%d', [Field.Name, FieldType.ClassName, Field.Offset, Field.TypeIndex]));
        Field := GetNextPublishedField(AClass, Field);
      end;

      WriteLn('  end;');
      WriteLn;
    end;
    AClass := AClass.ClassParent;
  end;
end;

Я также добавил подпрограмму, которая выводит реальное значение каждого поля – она более-менее эквивалентна коду выше, но только с добавленным вызовом GetPublishedFieldValue для получения значения поля. Чтобы протестировать этот код, я написал такой тестовый пример:

type
  {$M+}
  TMyClass = class
  published
    A: TObject;
    LongName: TComponent;
    B: TObject;
    C: TList;
    A2: TObject;
    L2ongName: TComponent;
    B2: TObject;
    C2: TList;
  end;

procedure Test;
begin
  DumpPublishedFields(TMyClass);
end;

И получил такой вывод:

type
  TMyClass = class(TObject)
  published
    A: TObject; // Offs=4, Index=0
    LongName: TComponent; // Offs=8, Index=1
    B: TObject; // Offs=12, Index=0
    C: TList; // Offs=16, Index=2
    A2: TObject; // Offs=20, Index=0
    L2ongName: TComponent; // Offs=24, Index=1
    B2: TObject; // Offs=28, Index=0
    C2: TList; // Offs=32, Index=2
  end;

Ну, это было очень весело! :-)

К этому моменту мы документировали три из самых интересных недокументированных полей таблицы VMT, которые указывают на RTTI информацию, генерируемую компилятором:

  TVmt = packed record
    // ..
    FieldTable        : PPft;
    MethodTable       : PPmt;
    DynamicTable      : PDmt;
    // ..
  end;

А вот поля, которые мы ещё не рассматривали:

  TVmt = packed record
    // ..
    IntfTable         : Pointer; 
    AutoTable         : Pointer;
    InitTable         : Pointer;
    TypeInfo          : Pointer;
    // ..
  end;

Если позволят время и мой интерес, я напишу про них в следующих статьях этой серии.

Подтверждение

Заметьте, что Ray Lischner документировал большинство этих структур RTTI в его великолепной книге Delphi in a Nutshell. Я раскапывал эти структуры самостоятельно, но независимое подтверждение моих находок всегда полезно.