Приветствую всех, кто начал читать эту заметку! Хочу предложить вам (а в большей степени фанатам 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) – товарищем Халлварда по обсуждению исходной идеи и фактическим его соавтором.

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

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

Совет # 17. Виртуальные переменные класса. Часть I

Корректная поддержка в 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

Совет # 17. Виртуальные переменные класса. Часть II

В части 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      : PFreeInstance;
    Destroy           : PDestroy;
   {UserDefinedVirtuals: array[0..999] of procedure;}
  end;

Преимущество повторного использования слота AutoTable:

• вам больше не нужен магический виртуальный метод
• он уже инициализирован nil (за исключением наследуемого Delphi 2-кода)
• вы можете использовать этот прием для любого класса, а не только для тех, которые унаследованы от вашего TBasicObject.

Главный недостаток указаного подхода заключается в том, что мы используем VMT-слот, который, потенциально, может быть использован, несмотря на то что секции автоматизации окончательно устарели начиная с версии Delphi 3.

Ностальгия: Delphi 2, COM и автоматизиция

Этот прием имеет тот недостаток, что он не является совместимым со старым Delphi 2-кодом, который использует секцию автоматизации. Этот механизм использовался еще в те времена, когда Delphi не поддерживало COM-совместимых интерфейсов, поэтому производителю пришлось реализовать COM-объекты с помощью абстрактных классов с виртуальными методами и тем самым обеспечить соответствие требованиям COM. Поскольку Delphi поддерживается только одинарное наследование классов, то только один «интерфейс» может быть реализован одним классом. Если вы хотите чтобы объект поддерживал несколько интерфейсов COM, каждый интерфейс должен быть реализован отдельным классом Delphi, и приходилось вручную писать методы QueryInterface, что бы обеспечить корректную маршализацию между реализациями «интерфейса» (читайте класса).

Секция автоматизации была необходима, чтобы обеспечить позднее связывание для поддержки автоматизации. Компилятор генерировал специальный RTTI для секций автоматизации, так что поддерживающий COM Delphi 2-код может перевести строковое имя метод или свойства в соответствующий вход вызова. В Delphi 3 поддержка СОМ была существенно улучшена с введением корректной поддержки интерфейсов и двойственного интерфейса (диспинтерфейса). Короче говоря, раздел автоматизации в настоящее время для классов (надеюсь) используется редко. Он может быть использован в коде для того чтобы получить RTTI для других целей (например, при реализации языка пользовательского сценария).

Если вам нужен доступ к полной RTTI для публичных или опубликованных методов и свойств, я бы рекомендовал использовать более полную и лучше документированную функцию $METHODINFO ON вместо этого. Боле е подробно об этом вы можете прочитать в моих сообщениях [7, 8, 9 и 10].

«Очищенный» хак — перезапись AutoTable

Изменение оригинального приема Патрика состоит в перезаписи существующего VMT-слота AutoTable, а не в размещении VMT-слота для нового виртуального метода, что по сути значительно упрощает первоначальный код:

type
  PClassVars = ^TClassVars;
  TClassVars = class(TObject)
  public
    InstanceCount: integer;
  end;

  TBasicObject = class(TObject)
  protected  
    class procedure SetClassVars(aClassVars: TClassVars);
  public
    class function GetClassVars: TClassVars; inline;
    function ClassVars: TClassVars; inline;
  end;

const
  vmtClassVars = System.vmtAutoTable;

function TBasicObject.ClassVars: TClassVars;
begin
  Result := PClassVars(PInteger(Self)^ + vmtClassVars)^; // Original code
end;

class function TBasicObject.GetClassVars: TClassVars;
begin
  Result := PClassVars(Integer(Self) + vmtClassVars)^;
end;

class procedure TBasicObject.SetClassVars(aClassVars: TClassVars);
begin
  PatchCodeDWORD(PDWORD(Integer(Self) + vmtClassVars), DWORD(aClassVars));
end;

Нам больше не нужно искусственно создавать strict private виртуальный метод, ни метод, чтобы чистить этот VMT-слот (мы предполагаем, что слот AutoTable уже свободен). Обратите внимание, что мы используем одну из магических констант из модуля System, чтобы определить смещение vmtAutoTable, которое мы будем в дальнейшем использовать. Вот соответствующий фрагмент модуля System:

const
  ...
{ Virtual method table entries }

  vmtSelfPtr           = -76;
  vmtIntfTable         = -72;
  vmtAutoTable         = -68;
  vmtInitTable         = -64;

Здесь вы видите, что AutoTable находится по отрицательному смещению -68 (или -$44 в шестнадцатеричном виде) от базового указателя TClass. Я также решил переименовать ClassInfo в ClassVars, чтобы избежать путаницы с существующей версией TObject.ClassInfo, которая стандартно возвращает указатель на RTTI опубликованных свойств в классе (и используется в модуле TypInfo). Методы SetClassInfo и ClassInfo — не статические методы класса (так, чтобы они могли получить неявные неявно ссылку на Self — параметр TClass, который содержит ссылку на текущий используемый класс). В то же время функция экземпляра ClassVar возвращает экземпляр TClassVars, который представляет собой объект, содержащий переменные класса для каждого индивидуального класса.

Чтобы сохранить код таким же простым и быстрым, я решил объявить поле InstanceCount непосредственно в классе TClassVars (вместо создания класса-потомка). Для того, чтобы добавить некоторую поддержку абстракции для инициализации слота ClassVars, я реализовал также простую процедуру регистрации:

procedure RegisterClassVarsSupport(const Classes: array of TBasicObjectClass);
var
  LClass: TBasicObjectClass;
begin
  for LClass in Classes do
    if LClass.GetClassVars = nil then
      LClass.SetClassVars(TClassVars.Create)
    else
      raise Exception.CreateFmt(
'Class %s has automated section or duplicated registration', [LClass.ClassName]);
end;

Наш «фруктовый» пример становится еще проще:

type

  TFruit = class(TBasicObject)
  public
    constructor Create;
    function InstanceCount: integer; inline; 
    class function ClassInstanceCount: integer; inline; 
  end;

  TApple = class(TFruit)
  end;

  TOrange = class(TFruit)
  end;
………………………
………………………
………………………
………………………

constructor TFruit.Create;
begin
  inherited Create;                                    
  Inc(ClassVars.InstanceCount);
end;

function TFruit.InstanceCount: integer;
begin
  Result := ClassVars.InstanceCount;
end;

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

initialization
  RegisterClassVarsSupport([TFruit, TApple, TOrange]);
end.

Тестовый код остается таким же, как и раньше. Быстрый взгляд на сгенерированный ассемблерный код для перехода к экземпляру объекта, с помощью TClass ссылки объекта в слот TClassVar в VMT, наконец, возврата ссылки на целое поле (InstanceCount) впечатляет:

Count := Apple.ClassInstanceCount;
asm
  MOV EAX,[ESI]
  ADD EAX,-$44
  MOV EAX,[EAX]
  MOV EBX,[EAX+$04]
end;

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

В настоящее время неясно как заставить компилятор вычислить ссылку на MOV reg с постоянным отрицательным смещением. Идеальной была бы ситуация при которой компилятор мог бы генерировать следующий ассемблерный код:

Count := Apple.ClassInstanceCount;
asm
  MOV EAX,[ESI]
  MOV EAX,[EAX-$44]
  MOV EBX,[EAX+$04]
end;

При этом вычитание константы $44 было бы введено в самом коде, а это меньше и быстрее, чем при явном изменении значения регистра. Возможно, я смогу обсудить этот вопрос в последующих своих сообщениях.
Также обратите внимание, что в то время как VMT любого класса имеют слот AutoTable, хотя мы все еще используем класс TBasicObject, от которого наследуется TFruit. Мы возможно позже пытаемся рассмотреть иные способы преодоления этого ограничения.

Я уже достаточно долго работаю над этим сообщением в своем блоге — большинство из вас должны уже спокойно спать — и к тому же, Windows Live Writer не позволяет мне редактировать в режиме HTML большие фрагменты кода в HTML, которые Delphi2HTML генерирует для меня. Мне кажется, этот редактор имеет невероятно глупое ограничение в 32 КБ для редактирования HTML (это что 1982 ??!). (Отон, он спас вас от еще более длинного поста).

В заключение я просто приведу слова Патрика:

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

Спасибо вам Патрик за обмен идеями и наше сотрудничество!

Все это очень интересно, но это лишь малая часть головоломки.

[Последний фрагмент сообщения Халлварда я исключил из публикации перевода, как впрямую не относящийся к теме виртуальных методов класса и не содержащей полезной технической информации].

Опубликовано HALLVARD VASSBOTN, в среду, 16 МАЯ 2007

ССЫЛКИ

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

Представляю свои соображения тезисно (это скорее примечания к отдельным моментам представленного перевода), детализация каждого наверно бы потребовала от меня написания отдельной статьи:

A. Удивляет позиция Borland/CodeGear/Embarcadero, которую их ведущие архитекторы и разработчики заняли относительно введения в синтаксис Object Pascal virtual class var («…that has been Closed with As Designed ages ago»). И это, пожалуй, характерный момент для Delphi. История развития языка, такой какой я ее наблюдал с момента появления на свет Delphi и моего знакомства с продуктами Borland, показывает, что каких-то новых (с точки зрения, отсутствия их присутствия в процедурных языках С, С++, Java, JavaScript и т.п.) синтаксических конструкций в язык не вводилось (исключением из этого правила можно считать helpr-ы). Складывается впечатление, что развитие возможностей языка шло и продолжает идти по принципу: сначала увидим, как это у других сложиться (как отреагируют пользователи – примут ли разработчики), а потом и реализуем. Возможно, я не прав.

B. Не слишком ли старое решение, чтобы его использовать? Старое – только от того, что было предложено в 2007 году? А что на сегодняшний день есть более достойное, «доведенное до ума» решение или Embarcadero уже реализовала этот «синтаксический сахар»? Для отдельных областей применения возможно, например, с помощью в той или иной степени универсальных регистров свойств классов, основанных на образце (pattern) «Одиночка». Но будут ли они по производительности такими же? Однозначно – нет (помните: от 2 до 4 ассемблерных инструкций для операции выборки объекта, эмулирующего виртуальную переменную класса!).

C. Можно ли использовать для аналогичных целей хэлперы (в их определение можно вводить стандартные переменные класса)? Безусловно – да. Удобно ли это будет делать? Нет. Можно ли их помощью решить те же задачи, что и с virtual class var? — Нет.

D. По поводу того, что это хак или «не хак» – обходной технологический прием. Я не хочу употреблять жаргонный термин «хак», имеющий для меня негативный смысл – как взлом, грубое вмешательство в работу программы, нарушающий ее правильное функционирование. Предложение Халлварда и Патрика, конечно же, частичное решение, технический паллиатив и обходной технологический прием. А если это грамотное и технически обоснованное решение по корректировке уже скомпилированного кода, если четко очерчены и известны область и риски (в данном случае, не «потокобезопасно», надо прямо сказать, весьма странный аргумент – кто-то захочет часто менять данные класса в runtime, да и еще из разных потоков?) его применения, то, почему бы, его не применять? Буду утверждать: их предложение можно и нужно использовать ровно до того момента пока Embarcadero (а может и не Embarcadero) не введет в синтаксис языка class ((static | <empty>) | virtual) var в соответствии с первоначальными спецификациями Халлварда (кстати, почему бы об этом не задуматься разработчикам Free Pascal?). И я не думаю, что для этого на данный момент существуют серьезные технические препятствия для реализации class virtual var.

Дальше я буду более конкретен.

E. По обходному приему. Еще раз хотел бы обратиться к коду первого варианта (варианта Патрика) решения. А именно к моменту, связанному с проверкой инициализации виртуальной переменной класса (см. код к разделу РЕШЕНИЕ):

………………………………………
if Pointer(ClassGetClassInfo) = Addr(TBasicObject.VMT_Placeholder1) then
………………………………………
………………………………………

Здесь я хотел бы (в том числе и для самого себя) еще раз зафиксировать следующие моменты:

E.1. Addr(TBasicObject.VMT_Placeholder1) всегда возвращает содержимое VMT-слота, связанное с адресом виртуального метода VMT_Placeholder1() базового класса TBasicObject.

Pointer(ClassGetClassInfo) возвращает содержимое VMT-слота, связанного с адресом виртуального метода VMT_Placeholder1() класса, наследуемого от TBasicObject. Это связано со следующими обстоятельствами:

E.2. ClassGetClassInfo() – есть метод класса, который вызывается в контексте VMT того класса-наследника, который вам необходимо проинициализировать. Он возвращает значение, связанное с VMT класса-наследника.

E.3. При компиляции, если виртуальный метод не переопределен (override), то соответствующий ему VMT-слот получает значение, совпадающее со значением VMT-слота исходного метода родительского класса (от этого «растут ноги» рассматриваемой проверки).

В варианте Патрика, эта проверка используется для инициализации VMT-слота VMT_Placeholder1 класса-наследника.

Обратите внимание, на его комментарий к секции инициализации:

initialization
// call this for any derived class too
// Аналогичный вызов должен быть сделан для каждого наследуемого класса.
  TBasicObject.InitVMTPlaceholders();
end.

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

initialization
// call this for any derived class too
// Аналогичный вызов должен быть сделан для каждого наследуемого класса.
  TFruit.InitVMTPlaceholders();
  TApple.InitVMTPlaceholders();
  TOrange.InitVMTPlaceholders();
end.

К своему стыду, для меня так и не стало понятно для чего собственно необходим вызов метода TBasicObject.InitVMTPlaceholders() и аналогичных для дочерних классов.

E.4. После присвоения значения VMT-слоту, он уже больше не содержит адреса виртуального метода, а содержит значение, которое является указателем на экземпляр (объект) класса, определенного нами в качестве контейнера для хранения необходимых переменных класса.

Данное обстоятельство мы можем использовать, не только для инициализации (очистки значения), но и для изменения по мере необходимости самого объекта — «виртуальной» переменной. Для этого, необходимо немного скорректировать код метода SetClassInfo:

class procedure TBasicObject.SetClassInfo(const AClassInfo: TClassInfo);
var
  AVirtualClassInfo: TObject;
begin
// Если Pointer(ClassGetClassInfo) <> Addr(TBasicObject.VMT_Placeholder) = true,
// то значение виртуальной переменной класса было уже было установлено!
  if (Pointer(ClassGetClassInfo) <> Addr(TBasicObject.VMT_Placeholder)) then
          begin // Это означает что инициализация необходимым значением выполнена!
            AVirtualClassInfo := ClassGetClassInfo();
// Но мы хотим сменить класс значения «виртуальной переменной класса» и поэтому устанавливаем новое значение!
            PatchCodeDWORD(@PBasicObjectOverlay (Self).VarClassInfo, DWORD(nil));
// Старое значение финализируем!
            System.SysUtils.FreeAndNil(AVirtualClassInfo);
          end;
        PatchCodeDWORD(@PBasicObjectOverlay(Self).VarClassInfo, DWORD(AClassInfo));
end;

F. Что будем делать, если нам понадобиться наследовать TBasicObject не от TObject или TInterfacedObject, а от какого-либо другого класса, уже имеющего в своем составе виртуальные методы? Здесь нас поджидает серьезный подвох. Если мы воспользуемся вариантом Патрика, то переменная будет читаться и писаться, но при этом абсолютно точно, что у вас запортятся VMT-слоты определенных ранее в родительских классах виртуальных методов (по всей видимости, мои утверждения, приведенные в пунктах 4.2 и 4.3, некорректны). Итак, вариант Патрика, без существенной переделки не «пройдет». Он содержит в себе серьезные ошибки.

Подойдет ли вариант Халлварда? Да, он работает безукоризненно! При этом вам не надо дорабатывать базовый класс контейнера виртуальной переменной (в последующем коде — это класс TVirtualClassVar). Приведу «очищенный» вариант Халлварда.

Объявление класса:

  type
    TVirtualClassVar = class
    end;
    TVirtualClassVarClass = class of TVirtualClassVar;
    PVirtualClassVar = ^TVirtualClassVar;

    TVirtualClassVarObject = class
    protected
      class procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); static;
      class function GetAddress(): PDWORD; inline;
    protected
      class function ClassGetClassInfo(): TVirtualClassVar; inline;
    public
      constructor Create(); overload; virtual;
      destructor Destroy(); override;
    public
      class function GetClassInfo<T: TVirtualClassVar>(): T; overload;
      class function GetClassInfo(): TVirtualClassVar; overload; inline;
      class procedure SetClassInfo(const AClassInfo: TVirtualClassVar); inline;
    end;
    TVirtualClassVarObjectClass = class of TVirtualClassVarObject;

Реализация методов:

constructor TVirtualClassVarObject.Create();
begin
  inherited Create();
end;

destructor TVirtualClassVarObject.Destroy();
begin
  inherited Destroy();
end;

class procedure TVirtualClassVarObject.PatchCodeDWORD(ACode: PDWORD; AValue: DWORD);
var
  ARestoreProtection: DWORD;
  AIgnore: DWORD;
begin
// Снимаем защиту от чтения/записи.
  if (VirtualProtect(ACode, System.SizeOf(ACode^), PAGE_EXECUTE_READWRITE, ARestoreProtection)) then
    begin
      ACode^ := AValue;
// Восстанавливаем защиту от чтения/записи.
      VirtualProtect(ACode, System.SizeOf(ACode^), ARestoreProtection, AIgnore);
      FlushInstructionCache(GetCurrentProcess, ACode, System.SizeOf(ACode^));
    end;
end;

class function TVirtualClassVarObject.GetAddress(): PDWORD;
begin
  Result := PDWORD(Integer(Self) + System.vmtAutoTable);
end;

class function TVirtualClassVarObject.ClassGetClassInfo(): TVirtualClassVar;
begin
  Result := PVirtualClassVar(PInteger(Self)^ + System.vmtAutoTable)^;
end;

class function TVirtualClassVarObject.GetClassInfo<T>(): T;
begin
  Result := (GetClassInfo() as T);
end;

class function TVirtualClassVarObject.GetClassInfo(): TVirtualClassVar;
begin
  Result := PVirtualClassVar(Integer(Self) + System.vmtAutoTable)^;
end;

class procedure TVirtualClassVarObject.SetClassInfo(const AClassInfo: TVirtualClassVar);
var
  AVirtualClassVar: TVirtualClassVar;
begin
  AVirtualClassVar := GetClassInfo();
  if (AVirtualClassVar <> nil) then
    begin
      if (AVirtualClassVar.Equals(AClassInfo)) then exit;
        PatchCodeDWORD(GetAddress(), DWORD(nil));
        System.SysUtils.FreeAndNil(AVirtualClassVar);
    end;
  PatchCodeDWORD(GetAddress(), DWORD(AClassInfo))
end;

Предлагаю читателю обратить внимание на метод TVirtualClassVarObject.SetClassInfo(…): в нем мною была введена возможность замещения имеющегося контейнера на другой.

Приведу пример, эксплуатируя «фруктовую тему».

Объявление контейнера виртуальных переменных класса (как и прежде, это всего лишь некоторое имя FInstanceName):

{$REGION 'TVirtualClassVarFruit'}
TVirtualClassVarFruit = class(TVirtualClassVar)
private
    FInstanceName: string;
protected
  function GetName(): string; overload; virtual;
  procedure SetName(const AValue: string); overload; virtual;
public
  constructor Create(const AName: string); overload; virtual;
  destructor Destroy(); override;
published
    property InstanceName: string read GetName write SetName;
end;
TVirtualClassVarFruitClass = class of TVirtualClassVarFruit;
{$ENDREGION 'TVirtualClassVarFruit'}

Объявление прикладных классов:

{$REGION 'TFruit'}

TFruit = class(TClassVarObject)
protected
  class function FruitClassInfo(): TVirtualClassVarFruit; inline;
  class procedure RegisterClassInfo(); static;
protected
  class constructor Create();
public
  constructor Create(); overload; virtual;
  class function Name(): string;
end;

TFruitClass = class of TFruit;

{$ENDREGION 'TFruit'}

{$REGION 'TApple'}

TApple = class(TFruit)
public
  constructor Create(); overload; override;
  destructor Destroy(); override;
end;
TAppleClass = class of TApple;

{$ENDREGION 'TApple'}

{$REGION 'TOrange'}

TOrange = class(TFruit)
end;
TOrangeClass = class of TOrange;

{$ENDREGION 'TOrange'}

Реализация методов контейнера виртуальных переменных класса (все предельно просто!):

{$REGION 'TVirtualClassVarFruit'}

constructor TVirtualClassVarFruit.Create(const AName: string);
begin
  inherited Create();
  FInstanceName := AName;
end;

destructor TVirtualClassVarFruit.Destroy();
begin
  inherited Destroy();
end;

function TVirtualClassVarFruit.GetName(): string;
begin
  Result := FInstanceName;
end;

procedure TVirtualClassVarFruit.SetName(const AValue: string);
begin
  FInstanceName := AValue;
end;

{$ENDREGION 'TVirtualClassVarFruit'}

Реализация методов прикладных классов:

{$REGION 'TFruit'}

class constructor TFruit.Create();
begin
  TFruit.RegisterClassInfo();
end;

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

class procedure TFruit.RegisterClassInfo();
begin
  TFruit.SetClassInfo(TVirtualClassVarFruit.Create('Фрукты'));
  TApple.SetClassInfo(TVirtualClassVarFruit.Create('Яблоки'));
  TOrange.SetClassInfo(TVirtualClassVarFruit.Create('Апельсины'));
  TApple.SetClassInfo(TVirtualClassVarFruit.Create('Яблоки 2'));
end;

class function TFruit.FruitClassInfo(): TVirtualClassVarFruit;
begin
  Result := (ClassGetClassInfo() as TVirtualClassVarFruit);
end;

class function TFruit.Name(): string;
begin
  Result := System.SysUtils.format('%s: %s', [ClassName, FruitClassInfo().InstanceName]);
end;
{$ENDREGION 'TFruit'}

{$REGION 'TApple'}
constructor TApple.Create();
begin
  inherited Create();
end;

destructor TApple.Destroy();
begin
  inherited Destroy();
end;

{$ENDREGION 'TApple'}

Обратите внимание, что в данном случае я выполняю инициализацию в конструкторе класса:

class constructor TFruit.Create();
begin
  TFruit.RegisterClassInfo();
end;
…………………………………
…………………………………
…………………………………
class procedure TFruit.RegisterClassInfo();
begin
  TFruit.SetClassInfo(TVirtualClassVarFruit.Create('Фрукты'));
  TApple.SetClassInfo(TVirtualClassVarFruit.Create('Яблоки'));
  TOrange.SetClassInfo(TVirtualClassVarFruit.Create('Апельсины'));
  TApple.SetClassInfo(TVirtualClassVarFruit.Create('Яблоки 2'));
end;

Но это – некритично. Инициализацию контейнера виртуальных переменных класса можно выполнять в секции инициализации, в конструкторе класса или конструкторе экземпляра класса, а, при необходимости, и в теле обычных методов. Можно замещать контейнер виртуальной переменной при необходимости другим экземпляром совместимого типа (этого во «фруктовом» примере делать необязательно, хотя я эту возможность реализовал и проверил, поскольку для моего приложения это критично: см. последний оператор в процедуре TFruit.RegisterClassInfo).

G. Можно ли использовать свойства класса (class property) для доступа к виртуальным переменным класса?

Полноценно использовать такие свойства нельзя. Причиной этого является ограничения, присущие Object Pascal и требующие использования для обращения к свойствам класса статических методов класса. Они всегда будут возвращать значение виртуальной переменной класса, связанное с базовым классом!

H. Можно ли так изменить код, чтобы вместо контейнера виртуальной переменной класса – объекта-значения использовать «чистую» виртуальную переменную класса простого типа? К сожалению, весьма ограниченно: необходимо уложиться в 4 байта для 32-рарядной платформы и в 8 байт для 64-разрядной. В целом: «овчинка не стоит выделки»!

I. Можно ли «шаблонизировать» TBasicObject и TClassInfo? Что я под этим понимаю? Положим, мы задали следующий обобщенный класс и реализовали его методы:

TVirtualClassVarObject<TParentClass: сlass, constructor> = class(TParentClass)
    .........
    protected
      class procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); static;
      class function GetAddress(): PDWORD; inline;
    protected
      class function ClassGetClassInfo(): TVirtualClassVar; inline;
    public
      constructor Create(); overload; virtual;
      destructor Destroy(); override;
    public
      class function GetClassInfo<T: TVirtualClassVar>(): T; overload;
      class function GetClassInfo(): TVirtualClassVar; overload; inline;
      class procedure SetClassInfo(const AClassInfo: TVirtualClassVar); inline;
end;

или

    TVirtualClassVarObject<TParentClass: TClass, constructor> = class(TParentClass)
    .........
    protected
      class procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); static;
      class function GetAddress(): PDWORD; inline;
    protected
      class function ClassGetClassInfo(): TVirtualClassVar; inline;
    public
      constructor Create(); overload; virtual;
      destructor Destroy(); override;
    public
      class function GetClassInfo<T: TVirtualClassVar>(): T; overload;
      class function GetClassInfo(): TVirtualClassVar; overload; inline;
      class procedure SetClassInfo(const AClassInfo: TVirtualClassVar); inline;
    end;

Затем в момент написания какого-либо приложения объявили следующие (в данном случае TDesignate – некоторый прикладной класс):

TMyAppClass = class(TVirtualClassVarObject<TDesignate>)
.......
.......
.......
end;

А далее, мы смогли бы, использовать виртуальную переменную класса TMyAppClass как нам это требуется.

Именно так не получиться, как бы нам этого ни хотелось. При объявлении обобщенных (шаблонных) классов в Object Pascal нельзя использовать следующую конструкцию:

TMyGenericClass<T: сlass, constructor> = class(T)
    .........
end;

Нельзя, а если сильно хочется? Можно ли использовать для этого хэлперы?

Можно!

J. Каким образом можно применить хэлперы?

Я просто приведу полную реализацию такого хэлпера.

Его объявление:

THelperVirtualClassVarObject = class helper for TObject
    protected
      class procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); static;
      class function GetAddress(): PDWORD; inline;
    protected
      class function ClassGetClassInfo(): TVirtualClassVar; inline;
    public
      class function GetClassVar<T: TVirtualClassVar>(): T; overload;
      class function GetClassVar<T: class, constructor;V: TVirtualClassVar>(): V; overload;
      class function GetClassVar(): TVirtualClassVar; overload; inline;
      class procedure SetClassVar(const AClassInfo: TVirtualClassVar); inline;
end;

Реализация:

{$REGION 'THelperVirtualClassVarObject'}

class procedure THelperVirtualClassVarObject.PatchCodeDWORD(ACode: PDWORD; 
AValue: DWORD);
var
  ARestoreProtection: DWORD;
  AIgnore: DWORD;
begin
// Снимаем защиту от чтения/записи.
  if (VirtualProtect(ACode, System.SizeOf(ACode^), PAGE_EXECUTE_READWRITE, ARestoreProtection)) then
    begin
      ACode^ := AValue;
// Восстанавливаем защиту от чтения/записи.
      VirtualProtect(ACode, System.SizeOf(ACode^), ARestoreProtection, AIgnore);
      FlushInstructionCache(GetCurrentProcess, ACode, System.SizeOf(ACode^));
    end;
end;

class function THelperVirtualClassVarObject.GetAddress(): PDWORD;
begin
  Result := PDWORD(Integer(Self) + System.vmtAutoTable);
end;

class function THelperVirtualClassVarObject.ClassGetClassInfo(): TVirtualClassVar;
begin
  Result := PVirtualClassVar(PInteger(Self)^ + System.vmtAutoTable)^;
end;

class function THelperVirtualClassVarObject.GetClassVar<T>(): T;
begin
  Result := (GetClassVar() as T);
end;

class function THelperVirtualClassVarObject.GetClassVar<T, V>(): V;
begin
  Result := (T.GetClassVar() as V);
end;

class function THelperVirtualClassVarObject.GetClassVar(): TVirtualClassVar;
begin
  Result := PVirtualClassVar(Integer(Self) + System.vmtAutoTable)^;
end;

class procedure THelperVirtualClassVarObject.SetClassVar(const AClassInfo: TVirtualClassVar);
var
  AVirtualClassVar: TVirtualClassVar;
begin
  AVirtualClassVar := GetClassVar();
  if (AVirtualClassVar <> nil) then
    begin
      if (AVirtualClassVar.Equals(AClassInfo)) then exit;
        PatchCodeDWORD(GetAddress(), DWORD(nil));
        System.SysUtils.FreeAndNil(AVirtualClassVar);
    end;
  PatchCodeDWORD(GetAddress(), DWORD(AClassInfo))
end;
{$ENDREGION 'THelperVirtualClassVarObject'}

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

K. Все это работает в VCL-проектах (Win32). Будет ли все это работать на других платформах?

Не знаю. Не проверял. Было бы неплохо, если кто-нибудь это проверил…

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