[Из песочницы] Vassbotn H. Виртуальные переменные класса29.05.2020 12:47

Приветствую всех, кто начал читать эту заметку! Хочу предложить вам (а в большей степени фанатам Object Pascal, любителям программистских трюков, технических приемов и синтаксических изысков) ознакомиться с переводом довольно старого (2007 года) поста "Hack#17: Virtual class variables, Part I" и "Hack#17: Virtual class variables, Part II" известного разработчика и автора многочисленных технических приемов, ориентированных на применение в Delphi, Халлварда Вассботна (Hallvard Vassbotn).

Сообщение Халлварда посвящено одной из интереснейших тем – возможности размещения и использования данных, связанных с конкретным классом прикладных объектов. Если вы подумали о константах или переменных класса, то вы окажетесь правы, но только частично.
Речь в этой заметке пойдет о class virtual var, по-русски это словосочетание звучит как виртуальная переменная класса (именно оно и вынесено в название данного перевода). Вы скажете, что такой синтаксической конструкции в Object Pascal’е нет, и окажетесь абсолютно правыми. Более того, я уверен, что знатоки и разработчики на других ОО-языках программирования заявят: в своей практике я не слышал, не сталкивался и не использовал ничего подобного. Как и все я «суслика не вижу…», но буду утверждать, что он может существовать. И об этом пойдет в речь в тексте предлагаемого вам перевода.

Предисловие от переводчика

На протяжении многих лет, которые прошли с момента моего первого прочтения поста Халлварда, я никак не мог решиться на использование в своих проектах его замечательной идеи. Но ее красота и предлагаемого Халлвардом обходного пути не оставляла и не оставляет меня в покое до сих пор.

Пришло время собирать камни: у меня появилась задача, та для которой наилучшим решением по ее реализации станет как раз «хак» (а я бы все-таки называл такие хаки – технологическими приемами) Халлварда. Раз можно использовать, то необходимо быть готовым к неожиданностям – еще раз изучить матчасть, перечитать устав, инструкцию…

Мне хотелось бы пояснить свои мотивы для работы над переводом сообщений Халлварда.

Обратившись к первоисточнику (часть 1, часть 2) и перечитав его, сопутствующие комментарии, я решил посмотреть русскоязычные ресурсы, посвященные этой теме и к моему удивлению, перевода и комментариев на русском языке заметок Халлварда на тему виртуальных переменных класса не обнаружил (большое количество заметок Халлварда было переведено и опубликовано Александром Алексеевым aka GunSmoker в его блоге, но именно эта тема им была почему-то пропущена), и если все так плохо – сложившуюся ситуацию надо исправлять. Тем более, что сама тема стоит того чтобы ее обсуждать, а не походя презрительно ее игнорировать (в духе следующего: «Я знаю как минимум одно решение этой проблемы, но это хак.»).

Оригинальное сообщение Халлварда состоит из двух частей. В первой части Халлвард кратко излагает суть идеи виртуальных переменных класса и о своих контактах с Borland (а начало истории его идеи относиться к 1998 году!) по поводу ее внедрения в синтаксис Object Pascal. Во-второй части он делиться двумя вариантами возможной эмуляции виртуальных переменных класса имеющимися в его распоряжении на 2007 год языковыми средствами Object Pascal (а это Delphi 2005-Delphi 2007). Сразу стоит отметить, что первоначальный вариант возможной эмуляции был предложен и реализован Патриком Ван Логхемом (Patrick van Logchem) – товарищем Халлварда по обсуждению исходной идеи и фактическим его соавтором.

Для того чтобы облегчить целостность восприятия идеи я решил объединить обе части исходного сообщения Халлварда в виде единого текста перевода. Таким образом, каждая часть стала в этой публикации отдельной главой. Также я счел возможным привести в послесловии некоторые свои соображения относительно самой идеи, предложенной реализации и возможных вариантах ее использования в практике разработки.

Итак, перевод…

Корректная поддержка в Object Pascal-е конструкции переменных класса class var впервые была введена в Delphi 8 для .NET, а затем в Delphi 2005 была реализована для платформы Win32. Функционально class var в Object Pascal (как и большинстве других языков) реализованы как глобальные переменные в области видимости класса, то есть время их жизни является глобальным и существует только одна копия такой переменной на каждое ее объявление в соответствующем классе. Практически это аналогично тому, как поступают большинство Delphi-программистов, используя объявление глобальной переменной в разделе реализации модуля, вместо объявления ее в классе.

Переменные класса для бедняков

Предположим, что вы хотите реализовать возможность подсчета количества созданных экземпляров класса. В Delphi 7 и в более ранних версиях вы могли бы написать:

type
  TFruit = class
  public
    constructor Create;
    class function InstanceCount: integer;
  end;  

implementation

var
  FInstanceCount: integer;

constructor TFruit.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end;

class function TFruit.InstanceCount: integer;
begin
  Result := FInstanceCount;
end; 

Здесь глобальная переменная FInstanceCount используется в качестве переменной «класса бедняка». При создании экземпляра класса эта переменная увеличивается, а далее мы можем использовать метод (функцию) класса для того, чтобы получить ее значение. (Да, более надежная реализация, вероятно, должна была основана на переопределении NewInstance и FreeInstance для увеличения и уменьшения значения счетчика, соответственно. И мы должны были бы сделать их потокобезопасными, но в данном контексте я постараюсь не усложнять дальнейшее изложение только ради полноты реализации – HV).

Языковая поддержка для переменных класса

Перенесемся в Delphi 2007, в котором мы можем переписать вышеприведенный код, используя class var (переменные класса также поддерживаются в Delphi 8 for .NET).

type
  TFruit = class
  private
    class var FInstanceCount: integer;
  public
    constructor Create;
    class property InstanceCount: integer read FInstanceCount;
  end;

implementation

constructor TFruit.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end; 

Обратите внимание, что мы заменили функцию класса InstanceCount на свойство класса. Такой прием уменьшает объем кода и делает его более эффективным. Подробности о полях и свойствах класса можете прочитать в главе 10 D4DNP [1] (ее фрагмент приведен в моем сообщении [2]).

Это изменение, скорее всего, удовлетворит ООП-пуристов, но базовая реализация (код на уровне процессора) остается неизменной. Переменной класса FInstanceCount при линковке присваивается статический адрес в глобальном сегменте данных. Следствием этого является то, что переменная класса распределяется между классом TFruit и всеми его классами-потомками.

Наивный подход

Предположим, некий наивный программист, желающий следить за количеством яблок и апельсинов, создаваемых в его приложении, решил написать что-то вроде:

type
  TApple = class(TFruit)
    // ..
  end;
  TOrange = class(TFruit)
    // ..
  end;

procedure Test;
var
  List: TList;
begin
  List := TList.Create;
  List.Add(TApple.Create);
  List.Add(TApple.Create);
  List.Add(TOrange.Create);
  Writeln('Apples: ', TApple.InstanceCount);
  Writeln('Oranges: ', TOrange.InstanceCount);
  readln;
end;

Ожидаемый им результат должен содержать 2 яблока и 1 апельсин, но фактический выход будет следующим:

Apples: 3
Oranges: 3

Причина, конечно, является то, что переменная класса разделяется между классами TFruit, TApple и TOrange.

Явная поклассовая реализация в переменных класса

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

type
  TFruit = class
  private
    class var FInstanceCount: integer;
  public
    constructor Create;
    class function InstanceCount: integer; virtual;
  end;
  TApple = class(TFruit)
  private
    class var FInstanceCount: integer;
  public
    constructor Create;
    class function InstanceCount: integer; override;
  end;
  TOrange = class(TFruit)
  private
    class var FInstanceCount: integer;
  public
    constructor Create;
    class function InstanceCount: integer; override;
  end;

implementation

constructor TFruit.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end;

class function TFruit.InstanceCount: integer;
begin
  Result := FInstanceCount;
end;

constructor TApple.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end;

class function TApple.InstanceCount: integer;
begin
  Result := FInstanceCount;
end;

constructor TOrange.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end;

class function TOrange.InstanceCount: integer;
begin
  Result := FInstanceCount;
end;

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

Apples: 2
Oranges: 1

Если придерживаться подобного подхода при реализации большой иерархии классов (скажем, в пользовательской библиотеке бизнес-классов), то очень рано вы столкнетесь с тем, что ваш код станет громоздким и необозримым. Свойство InstanceCount или функция введена в начальный базовый класс — так зачем их заново требуется реализовывать в каждом из подклассов?

Виртуальные переменные класса

Для решения поставленной задачи все, что нам потребуется, так это новая языковая конструкция – новый тип переменной класса, которая не должна реализовываться как простая глобальная переменная, а включалась в состав каждого класса или каждой VМТ. Можно назвать эту желаемую конструкцию языка полноценной виртуальной переменной класса (virtual class var) – виртуальной, потому что ее значение может изменяться в зависимости от того экземпляр какого класса был выбран – точно так же, как реализации виртуальной функции класса варьируется в зависимости от того какой класс был использован в момент исполнения кода. Воображаемый синтаксис этой воображаемой конструкции может быть следующим:

class var FInstanceCount: integer; virtual;

Это было бы самым естественным расширением синтаксиса, по моему мнению, но это потребует перевода «virtual» из категории директив в категорию зарезервированных ключевых слов. Подобная модернизация синтаксиса нарушит совместимость существующего кода, который использует «virtual» в качестве идентификатора, поэтому более реалистичным подходом к модернизации синтаксиса будет подход, который использует virtual как директиву. Это могло бы выглядеть как-то так:

  TFruit = class
  private
    class virtual var FInstanceCount: integer;
  public
    constructor Create;
    class property InstanceCount: integer read FInstanceCount;
  end;
  TApple = class(TFruit)
    //...
  end;
  TOrange = class(TFruit)
    //...
  end;

implementation

constructor TFruit.Create;
begin
  inherited Create;
  Inc(FInstanceCount);
end;

class function TFruit.InstanceCount: integer;
begin
  Result := FInstanceCount;
end;

procedure Test;
var
  List: TList;
begin
  List := TList.Create;
  List.Add(TApple.Create);
  List.Add(TApple.Create);
  List.Add(TOrange.Create);
  Writeln('Apples: ', TApple.InstanceCount);
  Writeln('Oranges: ', TOrange.InstanceCount);
  readln;
end;

Естественно, что этот код должен выдавать, то что от него и ожидается:

Apples: 2
Oranges: 1

Старый отчет

Это идея ведет свою историю с того самого момента, когда еще в 1998 году (тогда текущей версией была еще Delphi 4 и до реализации переменных и свойств класса должны были быть выпущены четыре последующих версии продукта) я сделал предложение Borland по реализации переменных класса с вышеуказанной семантикой. Приведу отрывки из моего первоначального предложения (that has been Closed with As Designed ages ago — который был закрыт в силу того, что реализация была уже завершена [честно говоря, так и не смог разумно перевести эту фразу! – прим. перев.]):

Пожалуйста, добавьте соответствующие поля класса. А также реализуйте поддержку свойств класса. Возможный синтаксис:

type
  TFoo = class
  private
    class FBar: integer;
    class procedure SetBar(Value: integer);
  public
    class property Bar: integer read FBar write SetBar;
  end;

class procedure TFoo.SetBar(Value: integer);
begin
  if Value <> FBar then
  begin
    FBar := Value;
  end;
end;

Эта языковая особенность очень полезна при работе с метаклассами. Вы можете, конечно, воспроизвести ее с помощью глобальных переменных, объявленных в секции реализации, но это не то чего я хочу. При использовании глобальной переменной, все производные классы будут иметь одни и те же значения переменных класса. Это не идеально.

Каждый новый производный класс должен иметь свою собственную копию переменной (так же, как и ClassName и InstanceSize являются уникальными для каждого класса). Хотя, обе идиомы могут быть одинаково полезными. Может быть, там должен быть отдельный синтаксис для совместно используемого поля класса?

  TFoo = class
  private
    class FBar: integer; const;

Хотя предложенный синтаксис отличается (мы всегда умны задним числом), это в основном тот же самый запрос, который мы обсуждали выше. Теперь мы знаем, что классические разделяемые переменные класса были реализованы; класс не имеет виртуальных полей класса. Я не обвиняю их (Borland/CodeGear) в простом пренебрежении, поскольку спрос для подобных нововведений тогда не был высок, да я и не знаю ни одного другого языка, в котором подобный синтаксис был бы реализован (действительно ли это так?).

Реализация виртуальной переменной класса

Как такая особенность языка может быть реализована? Мы знаем, как в настоящее время реализованы виртуальные методы класса (также как и методы экземпляра класса): компилятор создает уникальный слот в таблице виртуальных методов VMT для каждого введенного виртуального метода. Существует одна VMT для каждого класса. Каждый виртуальный метод имеет связанный с ним уникальный индекс (который может быть извлечен BASM с помощью директивы VMTINDEX) и который может быть использован для вычисления VMT-слота и поиска адреса кода виртуального метода.

VMT-слот на каждое поле

Что если мы добавим в VMT один дополнительный слот для объявленной виртуальной переменной класса? Это было бы слишком прямолинейным решением. Необходимо обеспечить при этом, чтобы VMT классов без использования виртуальной переменной класса не изменилась (а это 100% существующих классов). При этом также возникает другая проблема, которая заключается в том, что VMT хранится в сегменте кода и хранить значения каких-либо переменных в этом месте не является хорошей идей.

Я уже рассматривал в своих последних заметках технику самомодифицирующегося кода [3], позволяющего избежать проблем, связанных с нарушением прав доступа к страницам памяти и DEP (Data Execution Protection — предотвращение выполнения данных), а также предотвращать смешивания кода и данных. В частности, для записи данных в сегмент кода вы должны изменить права доступа к страницам памяти, в которые необходимо разместить данные. Также для того чтобы быть «добропорядочным гражданином», вы должны после всех произведенных манипуляций восстановить оригинальные права доступа. В том деле нам может помочь следующая процедура:

procedure PatchCodeDWORD(Code: PDWORD; Value: DWORD);
// Self-modifying code - change one DWORD in the code segment
var
  RestoreProtection, Ignore: DWORD;
begin
  if VirtualProtect(Code, SizeOf(Code^), PAGE_EXECUTE_READWRITE,
    RestoreProtection) then
  begin
    Code^ := Value;
    VirtualProtect(Code, SizeOf(Code^), RestoreProtection, Ignore);
    FlushInstructionCache(GetCurrentProcess, Code, SizeOf(Code^));
  end;
end;

И делает она это конечно не потокобезопасно. Если вам действительно «повезло», то другой поток может вклиниться и изменить права, прежде чем процедура получит шанс завершить операцию записи. Так что это не то, что вы хотите делать каждый раз, когда вы изменяете виртуальную переменную класса. Кардинальное решение одно.

Виртуальная Class Field Table

Делать что-то в VМТ является хорошей идеей, но хранить фактические данные в реальном времени там же — нет. Как обычно, добавление дополнительного уровня косвенности решает и эту проблему. Мы должны расширить VMT с новым волшеб-ным слотом – позвольте называть его ClassFieldTable (подразумевается, здесь мы говорим о виртуальных полях классов, в противном случае он недолжен принадлежать в VMT). Этот слот будет указывать на структуру (запись), размещаемую в глобальном сегменте данных. Запись должна содержать поля, которые соответствуют всем виртуальным переменным класса, которые были объявлены в классе или в классах-наследниках. Каждый производный класс должен иметь уникальную копию этой записи в сегменте данных — и ClassFieldTable-слот в VМТ указывает на соответствующий уникальный экземпляр.

В настоящий момент мы имеем решение проблемы записи данных в сегмент ко-да. Указатель на ClassFieldTable по-прежнему входит в VМТ и храниться в сегменте кода, но это уже не сформированный компоновщиком/загрузчиком сегмент кода с корректными и неизменяемыми во время исполнения записями глобальных переменных.

Дополнительное преимущество использования неявно объявленных глобальных переменных в записи виртуальной переменной класса для каждого отдельного класса является то, что мы можем использовать «магию» компилятора для финализации управляемых полей в записи (имеющих такие типы как AnsiString, WideString, интерфейс, Variant и динамический массив) без дополнительных усилий.

Реализация компляции

Теперь давайте представим с помощью псевдокода, что компилятор должен получить, на вход, чтобы скомпилировать виртуальные переменные класса. Вот модифицированный пример, в котором все три класса образует цепочку наследования 3х поколений. Я также добавил другую виртуальную переменную класса к одному из классов-потомков

type
  TFruit = class
  private
    class virtual var FInstanceCount: integer;
  public
    constructor Create;
    class property InstanceCount: integer read FInstanceCount;
  end;
  TCitrus = class(TFruit)
  end;
  TOrange = class(TCitrus)
  private
    class virtual var ClassDescription: string;
  end;

А вот псевдо-код, который пытается выразить то, что компилятор будет делать, чтобы реализовать вышеприведенный образец кода:

type
  TFruit = class
  private
    class virtual var FInstanceCount: integer;
  public
    constructor Create;
    class property InstanceCount: integer read FInstanceCount;
  end;
  TCitrus = class(TFruit)
  end;
  TOrange = class(TCitrus)
  private
    class virtual var ClassDescription: string;
  end;
// Compiler generated types and variables
var
  // Global variables used for per-class virtual class fields 
  FruitClassVars = record
    FInstanceCount: integer;
  end;
  CitrusClassVars = record // inherits field 
    FInstanceCount: integer;
  end;
  OrangeClassVars = record // inherits field, introduces new field 
    FInstanceCount: integer;
    ClassDescription: string;
  end;
  // New VMT slot initialization, generated by compiler:
  TFruitVMT = record

    ClassVarTable := @FruitClassVars;
  end; 
  TCitrusVMT = record
    ClassVarTable := @CitrusClassVars;
  end; 
  TOrangeVMT = record
    ClassVarTable := @OrangeClassVars;
  end; 

Интересно заметить, что все это очень напоминает мое же предложение девятилетней давности. Привожу дополнительные выдержки из того же своего предложения:

Как это реализовать:

Разделяемой тип переменной класса может быть реализован с использованием пространства глобального сегмента данных. Лежащая в основе реализация, таким образом, может быть такой же, как и с помощью глобальной переменной, но только при этом предлагаемый синтаксис будет более логичным (чем при использовании явной глобальной переменной).
Для каждого класса-одна-переменная типа поля класса может быть реализована путем добавления двух полей в VМТ:

ClassInstanceSize: Integer; 
ClassInstanceData: Pointer;

ClassInstanceSize даст количество байт, выделяемые для поля класса в каждом классе. ClassInstanceData будет указывать на блок памяти, содержащее поле класса. Этот блок памяти должен быть выделен в глобальном сегменте данных и инициализирован нулями.
Во время компиляции эти поля должны быть выделены при создании таблицы VMT. Класс, который наследует от другого класса и добавляет свои собственные поля будут иметь ClassInstanceSize = Parent.ClassInstanceSize + SizeOf (класс поле в этом классе).

Сейчас я думаю, что потребности в поле ClassInstanzeSize (или ClassVarTableSize) нет. Компилятор должен использовать эту информацию в своей внутренней бухгалтерии, но она не нужна во время выполнения. В некотором смысле это тот же случай, как и для виртуальных методов. Компилятор отслеживает количество виртуальных методов в каждом классе (как часть информации класса во время компиляции, хранящейся в .dcu), но генерируемый им код не нуждается в нем, и, следовательно, не нужно никакого поля VirtualMethodCount в VМТ. Та же логика применима и к нашим новым виртуальным полям класса и новому ClassVarTable-слоту.

Продолжение следует...

Данное сообщение стало достаточно большим и, поэтому, я решил разделить его на две части. Во второй части, в силу отсутствия в языке достаточного уровня поддержки виртуальных переменных класса, мы рассмотрим обходной путь их реализации.

ОПУБЛИКОВАНО HALLVARD VASSBOTN В ПЯТНИЦУ, 04 МАЯ 2007

В части I этого сообщения, мы ввели понятие виртуальных переменных класса, отсутствующую вплоть до настоящего времени (Delphi 2007 ) синтаксическую конструкцию Object Pascal (как и в большинстве других языков программирования). Мы также рассмотрели возможный синтаксис и предложили некоторые подробности реализации ее реализации в компиляторе. В этом сообщении мы попытаемся, несмотря на мнение некоторых писак, реализовать функциональность виртуального переменных класса в текущей версии Delphi, используя некоторые хитрые трюки и хаки. Первоначальная идея этой реализации принадлежит Патрику ван Logchem [4].

Решение

Что же нам делать, пока CodeGear (Embarcadero) все еще обдумывает возможность поддержки в компиляторах Delphi виртуальных полей класса?

Привожу выдержку из своей переписки с Патриком ван Логхемом (Logchem) из everyangle.com. Вот что он мне написал:

[...] Во всяком случае, я обнаружил реализацию в Delphi переменных класса начиная с версии 2005, но мне нужно что-то более конкретное: переменные класса специфичны. Это не стандартная конструкция языка, потому что в данном случае переменные класса просто другой тип глобальной переменной и для меня в этом нет особого смысла — я хочу следующее:

TClass1 =  class(TObject)
 public
   // written once, read _very_ frequently 
   class property Variable: Type;
 end;

 TClass2 = class(TClass1);

причем TClass1.Variable <> TClass2.Variable. На словах: при объявлении переменной этого типа, сам класс и все его производные классы должны иметь свою собственную версию этой переменной.

Это точно соответствует понятию виртуальной переменной класса, которое мы обсуждали в части I. Не довольствуясь отсутствующей поддержкой в Delphi, Патрик сделал то, что сделал бы любой истинный хакер — он придумал свое собственное решение. Патрик продолжает:

Я не нашел чисто языковую конструкцию, необходимую реализовать подобное простое требование, так что я начал взлом. Для того, чтобы добиться этого я попробовал использовать слот в VMT для хранения значения переменной! Привожу немного отредактированный кусочек исходного кода:

type
  PClass = ^TClass;
  // this class contains important meta-data, 
  // accessed _very_ frequently
  TClassInfo = class(TObject);

  TBasicObject = class(TObject)
  strict private
    procedure VMT_Placeholder1; virtual;
  protected
    class procedure SetClassInfo(const aClassInfo: TClassInfo);
  public
    class procedure InitVMTPlaceholders; virtual;
    function GetClassInfo: TClassInfo; inline;
    // Strange: Inlining of class methods doesn't work (yet)!
    class function ClassGetClassInfo: TClassInfo; inline; 
  end;

  PBasicObjectOverlay = ^RBasicObjectOverlay;
  RBasicObjectOverlay = packed record
    OurClassInfo: TClassInfo;
  end;

procedure PatchCodeDWORD(Code: PDWORD; Value: DWORD);
// Self-modifying code - change one DWORD in the code segment
var
  RestoreProtection, Ignore: DWORD;
begin
  if VirtualProtect(Code, SizeOf(Code^), PAGE_EXECUTE_READWRITE,
    RestoreProtection) then
  begin
    Code^ := Value;
    VirtualProtect(Code, SizeOf(Code^), RestoreProtection, Ignore);
    FlushInstructionCache(GetCurrentProcess, Code, SizeOf(Code^));
  end;
end;

class procedure TBasicObject.InitVMTPlaceholders;
begin
  // First, check if the VMT-mapping came thru the compiler alright :
  if Pointer(ClassGetClassInfo) = Addr(TBasicObject.VMT_Placeholder1) then
  begin
    // Now, empty the variable default, 
    // very important for later code !
    PatchCodeDWORD(@PBasicObjectOverlay(Self).OurClassInfo, DWORD(nil));

    // Now check that we see a cleaned up variable :
    Assert(ClassGetClassInfo = nil, 'Failed cleaning VMT of ' + ClassName);
  end
  else
    // When there's no original content anymore, this initialization 
    // has already been done - there _has_ to be a nil here :
    Assert(ClassGetClassInfo = nil, 
      'Illegal value when checking initialized VMT of ' + ClassName);
end;

function TBasicObject.GetClassInfo: TClassInfo;
begin
  Result := PBasicObjectOverlay(PClass(Self)^).OurClassInfo;
end;

class function TBasicObject.ClassGetClassInfo: TClassInfo;
begin
  Result := PBasicObjectOverlay(Self).OurClassInfo;
end;

class procedure TBasicObject.SetClassInfo(const aClassInfo: TClassInfo);
begin
  PatchCodeDWORD(@PBasicObjectOverlay(Self).OurClassInfo, DWORD(aClassInfo));
end;

procedure TBasicObject.VMT_Placeholder1;
begin
  // This method may never be called! 
  // It only exists to occupy a space in the VMT!
  Assert(False); 
  // This line prevents warnings about unused symbols
  // (until the compiler detects endless recursive loops)...
  VMT_Placeholder1; 
end; 

initialization
  // call this for any derived class too
  TBasicObject.InitVMTPlaceholders;
end.

Самое замечательное в этом решении состоит в том, что встраиваемый вызов GetClassInfo сводиться к последовательности следующих двух ассемблерных инструкций:

MOV EAX, [EAX]    // Go from instance to VMT
MOV EAX, [EAX+12] // read from the VMT at some offset (!)

Вы не можете добиться более быстрого кода, чем этот!

Да, действительно, этот быстрый код выглядит впечатляюще!

Анализируя взлом

Позвольте взять небольшую паузу и проанализировать то, что делает хак Патрика. Первое, что нужно отметить, это то, что он вводит базовый класс TBasicObject. Таким образом, все другие классы, которые должны обеспечивать хранение виртуальной переменной класса могут прямо или косвенно наследоваться от него. Базовый класс делает нечто своеобразное – он объявляет строгий частный (strict private) виртуальный метод (называемый VMT_Placeholder1), который никогда не может быть переопределен. Это сделано для того чтобы он никогда не был перекрыт (override) – фактически это делается для того, что зарезервировать слот в VMT – таблице виртуальных методов класса (и для всех его производных классов).

Резервирование слота в VМТ

Почему он хочет использовать пространство в VМТ? Это сделано конечно же для того, чтобы зарезервировать место, которое может использоваться для хранения значений классами, а не экземплярами классов! Смысл этому упражнению придает функция экземпляра класса GetClassInfo (и функция соответствующего класса ClassGetClassInfo) возвращающая экземпляр определенного пользователем класса TClassInfo, который собственно и содержит для дальнейшего использования программистом метаданные конкретного класса (если вам так больше нравится атрибуты класса, в духе .NET). Давайте более подробно рассмотрим реализацию этой функции:

function TBasicObject.GetClassInfo: TClassInfo;
begin
  Result := PBasicObjectOverlay(PClass(Self)^).OurClassInfo;
end;

Существует несколько тонкостей применяемого здесь приведения типов. Это функция экземпляра класса, поэтому неявный параметр GetClassInfo представляет собой самостоятельный (или в данном случае, TBasicObject) экземпляр класса TObject, чей метод вызывается далее. Как мы уже знаем, первые 4 байта блока памяти экземпляра класса содержит TClass, который реализуется как указатель на VMT класса. PClass(Self)^ первым делом разыменовывает указатель экземпляра и выдает копию указателя VМТ. VMT же содержит массив обычных пользовательских виртуальных методов класса. При отрицательных смещениях мы можем найти специальные виртуальные методы TObject и «волшебные» поля VMT (с деталями работы с VMT можно прочитать в моем сообщении [5]).

Магия преобразования типов

Ссылка TClass непрозрачна в том смысле, что вы не можете явно разыменовывать ее в своем коде, однако, компилятор делает это все время, когда вы вызываете виртуальные методы или осуществляете доступ к членам класса, таким, например, как ClassName. Код, показанный выше, принимает значение TClass и преобразует его в указатель RBasicObjectOverlay записи. Эта запись содержит одно поле, содержащее 4-байтовый OurClassInfo, который имеет тот же тип, что и метаобъект класса, к которому мы хотим получить доступ, а именно TClassInfo. Поскольку метод VMT_Placeholder1 является первым виртуальным методом в TBasicObject, и TBasicObject наследуется от TObject (который обычно не содержит виртуальных методов, т.е. VMT-слотов с положительными смещениями), доступ к полю OurClassInfo обеспечивает возврат значения VMT-слота, соответствующего VMT_Placeholder1. Понятно?

Как это выглядит со стороны компилятора

Проблема, конечно, заключается в том, что не во всех случаях VMT-слот VMT_Placeholder1 содержит ссылку на экземпляр TClassInfo. Вместо этого, он содержит адрес кода реализации виртуального метода (который всегда будет равен @TBasicObject VMT_Placeholder1 – помните, что будучи strict private, он не может быть переписан). Таким образом, мы должны немного снова «подлатать» VMT [6](я ведь действительно предупредил вас, что это хак?). Мы разделим эту задачу на две части — в секции инициализации для всех модулей для одного или нескольких потомков TBasicObject разместим код инициализации VМТ-слота, который позволит нам в дальнейшем использовать его для наших заявленных целей:

class procedure TBasicObject.InitVMTPlaceholders;
begin
  //First, check if the VMT-mapping came thru the compiler alright:
  if Pointer(ClassGetClassInfo) = Addr(TBasicObject.VMT_Placeholder1) then
  begin
    // Now, empty the variable default,
    // very important for later code !
    PatchCodeDWORD(@PBasicObjectOverlay(Self).OurClassInfo, DWORD(nil));

    // Now check that we see a cleaned up variable :
    Assert(ClassGetClassInfo = nil, 'Failed cleaning VMT of ' + ClassName);
  end
  else
    // When there's no original content anymore, this initialization
    // has already been done - there _has_ to be a nil here :
    Assert(ClassGetClassInfo = nil,
      'Illegal value when checking initialized VMT of ' + ClassName);
end;

initialization
  // call this for any derived class too
  TBasicObject.InitVMTPlaceholders;
end.

Во-первых, в этом коде предусмотрены некоторые проверки, гарантирующие, что значение нужного нам VMT-слота, содержимое которого мы собираемся изменить, соответствует нашим ожиданиям. Если слот не содержит статический код адрес метода TBasicObject.VMT_Placeholder1, метод либо был переопределен, не был объявлен как виртуальный метод, или мы получили не тот слот, который мы ожидали. Береженого Бог бережет.

Затем мы используем процедуру PatchCodeDWORD чтобы выполнить фактическую грязную работу по приписыванию значения nil в VMT-слот (тем самым эффек-тивно очищая его). Далее, опять проверяем, что нужное изменение прошло, вызывая исключение Assert, если что-то пошло не так.

Создание класса MetaInfo

Хорошо, мы сделали первый шаг. Присваивание nil-значения совместима в качестве ссылки на TClassInfo, но вы не можете хранить данные по нулевому указателю.

Следующим нашим шагом должно стать создание экземпляра TClassInfo и присвоение его текущей виртуальной переменной класса, состоящего в записи этой ссылки в доступный VMT-слот. Это должно быть сделано только один раз в каждый конкретный класс: эту операцию можно выполнить, например, в разделе инициализации модуля, или это может быть сделано с помощью какого-либо другого кода инициализации вашего проекта. Эта операция выполняется с помощью вызова метода класса SetClassInfo. Вот простой пример, где мы расширили применение конкретного TClassInfo с одним полем целого типа и конструктором для его инициализации:

type
  TClassInfo = class(TObject)
  public
    A: integer;
    constructor Create(Value: integer);
  end;

constructor TClassInfo.Create(Value: integer);
begin
  inherited Create;
  A := Value;
end;

initialization
  TBasicObject.InitVMTPlaceholders;
  TBasicObject.SetClassInfo(TClassInfo.Create(42));

Зная реализацию методов GetClassInfo и InitVMTPlaceholders, приведенную выше, реализация SetClassInfo не должна вас удивить:

class procedure TBasicObject.SetClassInfo(const aClassInfo: TClassInfo);
begin
  PatchCodeDWORD(@PBasicObjectOverlay(Self).OurClassInfo, DWORD(aClassInfo));
end;

В этом коде VMT-слот получает значение являющейся ссылкой на экземпляр нашего конкретного класса метаданных, например TClassInfo. Подобное изменение должно быть выполнено только один раз. После этого, класс конкретных TClassInfo можно получить с помощью функции GetClassInfo, и, соответственно, мы можем свободно читать и писать поля и свойства TClassInfo без какого-либо страха вызывать нарушение прав доступа к памяти. Экземпляр TClassInfo живет в динамической куче, так же, как и любой другой экземпляр любого другого класса.

Классы прикладного уровня

Написание дополнительных классов, которые поддерживают наши TClassInfo-переменные классов, просто. Для этого достаточно унаследовать соответствующий прикладной класс от TBasicObject, вызвать InitVMTPlaceholders для этого класса и присвоить новый экземпляр TClassInfo с помощью SetClassInfo. Давайте перепишем наш «фруктовый» пример из Части I, используя эту новую технику:

type
  TFruitClassInfo = class(TClassInfo)
  {unit} private
    var FInstanceCount: integer;
  end;
  TFruit = class(TBasicObject)
  protected
    class function FruitClassInfo: TFruitClassInfo; inline;
  public
    constructor Create;
    class function InstanceCount: integer;
  end;
  TApple = class(TFruit)
  end;
  TOrange = class(TFruit)
  end;

constructor TFruit.Create;
begin
  inherited Create;
  Inc(FruitClassInfo.FInstanceCount);
end;

class function TFruit.FruitClassInfo: TFruitClassInfo;
begin
  Result := ClassGetClassInfo as TFruitClassInfo;
end;

class function TFruit.InstanceCount: integer;
begin
  Result := FruitClassInfo.FInstanceCount;
end;

initialization
  TFruit.SetClassInfo(TFruitClassInfo.Create);
  TApple.SetClassInfo(TFruitClassInfo.Create);
  TOrange.SetClassInfo(TFruitClassInfo.Create);
end.

Обратите внимание, код стал гораздо проще. Функция InstanceCount вводится и полностью реализуется в классе TFruit – для классов TApple и TOrange ничего не надо делать и даже более того вы больше не должны его реализовывать. Поскольку компилятор не поддерживает виртуальные переменные класса, мы видим только наличие связанного с этим приемом дополнительного кода в разделе инициализации.

Поленившись, я пропустил проверку и перезапись VMT-слота с nil (вызывается InitVMTPlaceholders для каждого класса). Мне нравится рисковать.

Вводим класс, который наследуется от общего предка TClassInfo и добавляем нужные нам переменные. Для того, чтобы получить безопасный доступ по типу к экземплярам класса TFruitClassInfo, я также написал класс-функцию (FruitClassInfo), которая возвращает значение нужного мне типа.

Устройство ClassInfo

В зависимости от требований к приложению и гомогенности ваших прикладных классов, вы можете использовать единственный класс TClassInfo, который содержит все поля и свойства, используемые всеми подклассами, или же создавать определенные потомки TClassInfo. Использование единственного общего класса может оказаться способом получения более быстрого кода, поскольку вам не нужно выполнять приведение типа (можно «смошенничать», используя более быстрый жесткий способ приведения типа, вместо as-приведения).

Подводные камни встраивания (inlining)

Вызов метода экземпляра GetClassInfo критически важен для достижения приемлемой производительности вашего кода, а это предполагает, что у вас должен быть «живой» экземпляр (а не статическая или динамическая ссылка) выполнения его вызова. Для решения подобной задачи в настоящее время существует возможность встраивания компилятором кода метода по месту вызова, что по бытующему мнению позволяет получить более быстрый код. Если вы в состоянии прочитать перечеркнутый мною выше фрагмент, то не следуют воспринимать его буквально – в момент его написания я был под влиянием одного плохого образца кода. В коде Патрика TBasicObject.InitVMTPlaceholders вызывает встраиваемый метод класса ClassGetClassInfo, и если вы внимательно посмотрите на сгенерированный компиля-тором код, то вы увидите, что вызов не встраиваются. Спустя некоторое время я понял причину – порядок реализации методов. Реализация встраиваемого метода должна быть «видна» компилятору перед обращением к нему — в противном случае компилятор не сможет встроить его код. Компилятор Delphi явно и намеренно раз-работан как однопроходный компилятор, что вполне естественно. Компилятор не может создать выходной код до тех пор, пока этот код не объявлен. С этим моментом может столкнуться любой другой разработчик, поэтому я обновил свое сообщение, связанное с реализацией встраивания вызова метода (ссылка). Если вы переместите InitVMTPlaceholders ниже в ClassGetClassInfo, то его вызов будет встраиваемым. Приятно, что можно избавиться от этого маленького недоразумения.

С точки зрения производительности

Как отметил Патрик в своем письме, сочетание встраивания метода экземпляра GetClassInfo и преобразование позволяют компилятору создавать очень эффективный код обращения к каждому классу метаданных TClassInfo из экземпляра класса:

ClassInfo := Apple.GetClassInfo;
// With inlinging and optimization enabled 
// this compiles into
asm
   MOV EAX,[EAX]
   MOV EAX,[EAX]
end;

Для того, чтобы получить от объекта метаинформацию класса TClassInfo достаточно двух машинных кодов и двух обращений к памяти. Первое обращение идет от TObject к TClass, второе возвращает содержимое первого VМТ-слота (т.е. индекс и смещение 0). Действительно, быстрее не получишь — очень впечатляет!

Очищение хака?

Я думаю, что Патрик понимал какой хак он достал из своего рукава, но в то же время что-то его все-таки беспокоило. Можно ли это быть сделать по-другому, лучше или чище?

Это, скорее всего, не может быть сделано быстрее.

Снова процитирую Патрика:

Но эта функциональность не должна быть настолько грязно реализована — возможно, вы знаете более чистое решение, чем это?

Наверно можно написать более чистое решение, но оно, скорее всего, будет более медленным. Один из способов заключается в использовании хэш-таблицы с использованием в качестве ключа ссылку на TClass: в этом случае выборка экземпляра TClassInfo может осуществляться по соответствию определенному зарегистрированному классу.

В зависимости от вашей точки зрения на эти вопросы, вы могли бы сделать подход более или менее чистым, не используя новый VMT-слот для этого, а скажем переписать и повторно использовать один из неиспользованных магических VMT-слотов, например указатель на таблицу автоматизированных методов AutoTable — атавизм Delphi 2, который уже как правило, больше не используется. Приведем в псевдозапись VMT (его объявление взято из этого поста):

type
  PVmt = ^TVmt;
  TVmt = packed record
    SelfPtr           : TClass;
    IntfTable         : Pointer;
    AutoTable         : Pointer;
    InitTable         : Pointer;
    TypeInfo          : Pointer;
    FieldTable        : Pointer;
    MethodTable       : Pointer;
    DynamicTable      : Pointer;
    ClassName         : PShortString;
    InstanceSize      : PLongint;
    Parent            : PClass;
    SafeCallException : PSafeCallException;
    AfterConstruction : PAfterConstruction;
    BeforeDestruction : PBeforeDestruction;
    Dispatch          : PDispatch;
    DefaultHandler    : PDefaultHandler;
    NewInstance       : PNewInstance;
    FreeInstance      : PFre
    
            
© Habrahabr.ru