Free Pascal: Трюки с объектами

Введение

Данный пост я решил написать после дискуссии на форуме freepascal.ru, из которой я для себя узнал много всего полезного. За ценные знания большое спасибо Vapaamies, runewalsh и Сергею Горелкину, также вклад в дискуссию внесли zub и stanilar.

В посте будет рассказано о читах разной степени приемлимости, но даже если у вас нет необходимости в их применении, пост поможет глубже понять устройство объектов в паскале. Под объектами здесь и далее подразумеваются типы, объявленные как object, а не class. С class'ом многие рассматриваемые тут задачи решаются легко, т.к. язык поддерживает и указатели на конструкторы, и виртуальные конструкторы, и классовые типы (т.е. class of ...).

Тем не менее, в последнее время я возвращаюсь к истокам и всё чаще использую именно object, т.к. в отличии от class, он (1) может быть создан на стеке или внутри какой-то внешней структуры, не затрачивая времени на аллокацию, что полезно для мелких и короткоживущих объектов, и (2) гораздо легковеснее, не несёт с собой в программу RTTI, что может быть полезно при приступах оптимизаторской паранойи.

Непрямой вызов конструктора

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

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

Тем не менее, непрямой вызов конструктора отчасти поддерживается функциями CallVoidConstructor и CallPointerConstructor из модуля Objects. Приведу тривиальный пример их использования:

uses
  Objects;

type
  TMyObject = object
    constructor Init1;
    constructor Init2(Param: Pointer);
  end;

constructor TMyObject.Init1;
begin
end;

constructor TMyObject.Init2(Param: Pointer);
begin
  Writeln(PAnsiChar(Param));
end;

const
  P: PAnsiChar = 'I am really an PAnsiChar value';

var
  O: TMyObject;

begin
  CallVoidConstructor(@TMyObject.Init1, @O, TypeOf(TMyObject));
  CallPointerConstructor(@TMyObject.Init2, @O, TypeOf(TMyObject), P);
end.

Таким образом, чтобы проинициализировать объект, мы должны знать не только указатель на конструктор, но и TypeOf объекта (о том, что это такое, будет видно ниже, если вы ещё не ходили по ссылкам). Для многих случаев этих двух функций достаточно, но что делать, если у нашего конструктора другой набор параметров? Давайте заглянем внутрь модуля Objects и посмотрим как эти функции в нём реализованы:

{ Constructor calls.

  Ctor     Pointer to the constructor.
  Obj      Pointer to the instance. NIL if new instance to be allocated.
  VMT      Pointer to the VMT (obtained by TypeOf()).
  returns  Pointer to the instance.
}

...

type
...
  VoidConstructor = function(VMT: pointer; Obj: pointer): pointer;
  PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer;

...

function CallVoidConstructor(Ctor: codepointer; Obj: pointer; VMT: pointer): pointer;inline;
begin
  CallVoidConstructor := VoidConstructor(Ctor)(Obj, VMT);
end;

function CallPointerConstructor(Ctor: codepointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;inline;
{$undef FPC_CallPointerConstructor_Implemented}
begin
  {$define FPC_CallPointerConstructor_Implemented}
  CallPointerConstructor := PointerConstructor(Ctor)(Obj, VMT, Param1)
end;

Отлично! Из этого кода мы видим реальную сигнатуру конструктора. Если потребуется вызвать конструктор с какой-то другой сигнатурой, то мы знаем как это сделать: нужно объявить аналогичным образом тип конструктора, и скастовать к нему указатель. Кроме того, мы видим что реально делает TypeOf — возвращает указатель на виртуальную таблицу методов (VMT).

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

Мне же непрямой вызов конструктора потребовался для реализации «двойной буферизации»: у меня есть программа, в которой объекты в коллекции итеративно обновляются, и пока все объекты не обновились, нужно помнить предыдущее состояние каждого объекта. Для этого для каждого объекта создаётся его копия, в которой хранится следующее состояние, а инициализация оригинала и копии и связывание их друг с другом объединены в одну функцию — достаточно в неё лишь «передать конструктор». Довольно сумбурно я всё это описал, но поедем дальше.

Как устроен конструктор

Можно обратить внимание на то, что если в указанные выше функции передать Obj=nil, то объект будет выделен в куче, и указатель на него будет возвращён. Закономерный вопрос: а откуда конструктор знает какого размера нужен объект? Мы его явно не передаём.

Давайте попробуем разобраться. Если посмотреть ассемблерный код какого-нибудь конструктора, то в нём, помимо самого тела конструктора, будет вызвана функция fpc_help_constructor. Посмотрим её код (см. rtl/inc/generic.inc):

type
  pobjectvmt=^tobjectvmt;
  tobjectvmt=record
    size,msize:sizeuint;
    parent:pointer;
  end;

{$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
{ Note: _vmt will be reset to -1 when memory is allocated,
  this is needed for fpc_help_fail }
function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;[public,alias:'FPC_HELP_CONSTRUCTOR'];compilerproc;
var
  vmtcopy : pobjectvmt;
begin
  vmtcopy:=pobjectvmt(_vmt);
  { Inherited call? }
  if vmtcopy=nil then
    begin
      fpc_help_constructor:=_self;
      exit;
    end;

  if (_self=nil) and
     (vmtcopy^.size>0) then
    begin
      getmem(_self,vmtcopy^.size);
      { reset vmt needed for fail }
      _vmt:=pointer(-1);
    end;
  if _self<>nil then
    begin
      fillchar(_self^,vmtcopy^.size,0);
      ppointer(_self+_vmt_pos)^:=vmtcopy;
    end;
  fpc_help_constructor:=_self;
end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}

Вот что тут написано:

1. Сразу выходим из функции, если _vmt нулевой, — это нужно в том случае, когда объект уже проинициализирован функцией fpc_help_constructor ранее и для него был вызван конструктор предка (при помощи inherited).
2. Если _self нулевой, то объект выделяем в куче, при этом размер получаем из виртуальной таблицы методов (а именно, выражением vmtcopy^.size). Если помните, указатель на VMT возвращается при помощи TypeOf.
3. Инициализируем объект, тупо забивая его нулями. (Вот вам и инициализация строк, интерфейсов, динамических массивов и прочих управляемых типов данных, — одной строкой!)
4. Сохраняем в объекте указатель на VMT.

На практике в реальной программе размер объекта мы можем узнать при помощи SizeOf, хотя теоретически можно было бы прочесть из TypeOf, скастовав его к самописному TObjectVmt.

Меняем VMT на лету

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

Нужно попытаться записать VMT в объекте самостоятельно, как это сделано в fpc_help_constructor. Единственное, что нам мешает, — непонятное _vmt_pos. Что это и откуда его взять? Чтобы ответить на этот вопрос, нужно сперва понять как устроены объекты.

К следующим нескольким абзацам можно относиться как к отсебятине: автор поста не обладает полным пониманием того, как устроены объекты, т.к. код компилятора, формирующий внутреннюю структуру объекта, довольно сложен. Тем не менее, автор общался с тем, кто приложил руку к его написанию, и описанное поведение воспроизводится в разных окружениях (тестировалось в Windows XP 32bit, Windows 7 64bit, Windows 8 64bit, FreeBSD 32bit, Debian 64bit и MacOS 64bit), что даёт основание считать его довольно близким к истине. Читатель при желании может самостоятельно взять тестовую программу и, видоизменив её, попытаться опровергнуть нижеследующий текст.

В случае, когда объект не содержит виртуальных методов (и конструкторов), он устроен точно также, как и записи (record): просто выровненная или невыровненная последовательность полей в порядке их объявления. Если мы унаследуем от такого объекта другой объект, и он тоже будет без виртуальных методов, то новые поля будут добавлены в конец.

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

Очень простое и довольно естественное устройство объекта. Думаю, что пример кода приводить не нужно, а если и нужно, — то он уже приведён по ссылке выше на тестовую программу. Теперь можно сказать, что _vmt_pos — это смещение в памяти от начала объекта до того места, где хранится указатель на VMT. В общем случае корректно определить его точное значение — задача непростая, нужно знать в каком объекте иерархии впервые появился VMT, размер этого объекта и особенности вырванивания. Я не смотрел можно ли это сделать при помощи RTTI информации, например, из модуля TypInfo. Но в некоторых частных случаях определить смещение довольно легко. Например, когда данных в объекте нет вообще, смещение будет равно нулю. На основе этого мы можем написать следующий код:

type
TFlexible = object
  destructor Done; virtual;
  function GetVMT: Pointer; inline;
  procedure SetVMT(_VMT: Pointer); inline;
  property VMT: Pointer read GetVMT write SetVMT;
end;

destructor TFlexible.Done;
begin
end;

function TFlexible.GetVMT: Pointer;
begin
  Result := PPointer(@Self)^;
end;

procedure TFlexible.SetVMT(_VMT: Pointer);
begin
  PPointer(@Self)^ := _VMT;
end;

Теперь достаточно унаследовать от этого объекта свой и мы сможем менять его VMT!

type
TAnimal = object(TFlexible)
  FName: AnsiString;
  constructor Init(const Name: AnsiString);
  procedure TellAboutYourSelf; virtual; abstract;
end;

TCat = object(TAnimal)
  procedure TellAboutYourSelf; virtual;
end;

TDog = object(TAnimal)
  procedure TellAboutYourSelf; virtual;
end;

constructor TAnimal.Init(const Name: AnsiString);
begin
  FName := Name;
end;

procedure TCat.TellAboutYourSelf;
begin
  Writeln('Я кот по имени ', FName, '.');
end;

procedure TDog.TellAboutYourSelf;
begin
  Writeln('Я ', FName, ', гав-гав!');
end;

var
  Pet: TAnimal;

begin
  Pet.Init('Бусик');
  Pet.VMT := TypeOf(TCat);
  Pet.TellAboutYourSelf;
  Pet.VMT := TypeOf(TDog);
  Pet.TellAboutYourSelf;
  Pet.Done;
end.

Круто, правда?

Стоит отметить, что переключение состояния при помощи ООП можно реализовать и традиционными способами, к примеру паттёрном State. Варианты реализации этого паттёрна в паскале: раз и два. В то же время, смена VMT в один оператор присваивания без какого-то дополнительного кода имеет свои прелесть и изящество.