Ускоренная обработка данных типа Variant в Delphi

Общеизвестно, что работа с данными типа Variant выполняется медленно. Так, справочная система Borland Delphi 6.0 утверждает, что (вольный перевод) «Данные типа Variant обеспечивают большую гибкость, но занимают больше памяти, чем обычные переменные, и операции над ними выполняются медленнее, нежели над статически типизированными данными». В том же смысле высказывается и А.Я. Архангельский в книге «Программирование в Delphi 6» - правда, начисто забывает упомянуть содержащееся в справочной службе одним предложением дальше указание, что в Delphi 6 появился принципиально новый вид Variant’ов – Variant, определяемый программистом (custom variant). Впрочем, речь здесь пойдет не о нем.

Утверждения о низком быстродействии, а также тот факт, что во многих книгах, посвященных Delphi, уделяется недостаточное внимание вопросам, связанным с языком – предполагается, видимо, что для программирования в Delphi вполне достаточно овладеть двигательными навыками Drag&Drop – привело к тому, что во всех книгах по Delphi, которые мне доводилось читать, тип данных Variant рассматривался лишь вскользь, в контексте работы с OLE Automation. При этом, несмотря на упоминание Variant в контексте Automation, часто не приводилось даже намека на то, что тип Variant введен в Delphi именно для поддержки OLE Automation. Тип TVarData, к которому приводится VARIANT – незначительное расширение структуры VARIANT из Automation, для ознакомления с которой можно порекомендовать достаточно подробную статью [1].

Такое пренебрежение этим элементом языка не вполне оправданно. Как будет показано далее, работа с данными типа Variant в некоторых случаях может быть ускорена. С другой стороны, существует ряд ситуаций, в которых использование Variant оказалось бы весьма кстати, если бы такого ускорения удалось добиться. В частности, с учетом отсутствия в Delphi шаблонов (похоже, это скоро изменится – Delphi полным ходом движется в направлении .NET, а все языки второй версии .NET обязаны будут поддерживать обобщенное программирование – прим. ред.), можно было бы описать в универсальном виде алгоритм вычисления, скажем, среднего значения в массиве – притом, что данные в массиве могут быть как целыми, так и вещественными, или custom variant (например, комплексными числами). Вообще, возможна задача обработки потоков данных – сложение двух векторов, вычисление среднего значения – когда конкретный тип данных неизвестен на момент написания функции-обработчика или вообще может быть различным.

Причина медленной обработки значений типа Variant в том, что на момент компиляции некоторой операции над значением фактический тип последнего (т.е. что же именно было помещено в Variant) неизвестен, а потому компилятор генерирует код, анализирующий содержащуюся в значении информацию о типе, и в зависимости от результата вызывает соответствующую операцию. Так, для пары целых чисел будет выполнено целочисленное сложение, а для пары строк (напомню, что Delphi позволяет помещать в Variant, помимо BSTR, и обычные для Delphi AnsiString, т.е. строки с 8-битовой кодировкой символов, счетчиком длины строки, счетчиком ссылок и нулевым терминатором) – их конкатенация.

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

Низкая скорость работы с Variant – лишь частный случай более общей проблемы динамической диспетчеризации. Вычисления с Variant по умолчанию ведутся с помощью довольно медленных функций Variant-диспетчера Delphi (который, в свою очередь, иногда обращается к OLE Automation API). Диспетчер анализирует значение поля VType Variant-а и вызывает подходящую для обработки функцию, оперирующую конкретными типами. Таким образом, какому коду передать управление, становится известно только на этапе выполнения программы, и необходимость этого выяснения замедляет вызов. Другой ее частный случай – вызов виртуального метода объекта. Для осуществления такого вызова необходимо: прочитать из занимаемой объектом области памяти адрес таблицы виртуальных методов, соответствующей фактическому типу объекта, затем прочитать из этой таблицы адрес фактически вызываемого метода и выполнить передачу управления по этому адресу. Если бы фактический тип объекта был известен до вызова метода, то известен был бы и адрес метода, и не пришлось бы выполнять две дополнительных операции чтения из памяти. А медленный и трудно предсказуемый (в смысле конечного адреса) косвенный переход (т.е. по адресу, не указанному непосредственно, а хранящемуся в регистре процессора или ячейке памяти) можно было бы заменить более быстрым и предсказуемым прямым.

Существует статья о вызовах виртуальных методов [2] показывающая совершенно фантастические результаты сравнения времени выполнения некоторого цикла, состоящего из виртуальных вызовов пяти совершенно тривиальных методов объекта – просто возвращающих некоторое число, в программе на C++ и на SmallTalk. Последний, являясь динамически типизированным языком с (в использованной реализации) отложенной компиляцией, показал производительность в 2.3 раза (!) выше, чем в использованной реализации C++.

Причины и решения

Лидерство SmallTalk объясняется тем, что для уменьшения потерь производительности при динамической диспетчеризации (которая в SmallTalk более трудоемка, нежели в C++ или Delphi) в современных реализациях SmallTalk употребляется технология Polymorphic Inline Caches [3]. Возникает естественный вопрос: что мешает реализовать подобный подход, например, в Delphi?

Существует работа [4], в которой описывается препроцессор для C++, преобразующий исходный текст программы с целью замены виртуальных вызовов прямыми. Препроцессор делает предположение о том, что ссылка на объект не изменяется на протяжении некоторого участка кода, и заменяет в этом участке кода косвенные (виртуальные) вызовы прямыми. Процесс замены косвенных вызовов прямыми можно назвать связыванием, или привязкой. Поскольку в этой статье замена косвенных вызовов прямыми будет упоминаться очень часто, а сформировавшийся термин для этого процесса в русском языке отсутствует, автор в дальнейшем будет использовать перевод английского словосочетания direct binding – прямая привязка.

С первого взгляда можно и не уловить связи между устранением виртуальных вызовов и ускорением работы с Variant. Однако и в случае с виртуальными вызовами, и в случае использования функций API Variant имет место динамическое определение метода, который необходимо вызвать – с той лишь разницей, что в первом случае поиск адреса метода производится в виртуальной таблице, а во втором определяется с помощью анализа типов аргументов.

Для уменьшения накладных расходов при работе с Variant необходимо сочетать две техники. Во-первых, поскольку анализ типов следует выполнить один раз, но не выполнять в дальнейшем, то необходимо подменить операцию, выполняющую вызов процедуры – таким образом, что медленный универсальный вызов заменяется прямым вызовом по уже установленному конкретному адресу. Такой прием, когда косвенный вызов в той или иной форме заменяется прямым, в [3] назван inlining – на взгляд автора, не вполне удачно. Этот термин обычно употребляется в смысле развертывания, подстановки вызываемого кода вместо команды вызова, тогда как в [3] не происходит ни подстановки конкретного вызываемого метода, ни даже подстановки действий по выяснению этого метода. Термин же «привязка», хотя и несколько перегружен, в словосочетании «прямая привязка» достаточно точно выражает то, что в данном случае происходит: «нацеливание» вызова на конкретный участок исполнимого кода программы.

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

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

Это может выглядеть так: если он уверен, что данная операция в течение некоторого времени будет обрабатывать только данные определенного фактического типа (т.е. вызывать методы объектов одного класса, или складывать два Variant-значения каждый раз одних и тех же типов), он может сообщить об этом подсистеме прямой привязки. Схема может быть такой:

Диспетчер вызовов (в данном случае – диспетчер Variant’ов) при первом запуске операции в цикле проверяет, разрешена ли прямая привязка, и если да – заменяет в исполняемом коде, порожденном при компиляции операции A[i] + B[i], вызов метода-диспетчера прямым вызовом нужной процедуры, выполняющей сложение для двух Variant’ов данных конкретных типов (тип первого определяется по типу A[i], второго – по типу B[i]).

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

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

А имеющийся в его распоряжении компилятор Delphi генерирует для операции “ + ” над Variant’ами один и тот же код, к сожалению, плохо подходящий для модификации во время исполнения. Следовательно, сложение придется заменить менее естественной записью, позволяющей учесть прямую привязку внутри собственной функции-посредника VarAdd:

В одном участке кода могут существовать независимые группы операций с Variant-ами, и тип обрабатываемых значений для каждой группы может быть своим. В следующем примере одна группа – операции над A[i] и B[i], другая – над VarString1 и VarString2. Имеет смысл хранить информацию о привязке некоей группы операций в специальном объекте:

Вместо разрешения/запрета можно использовать создание/удаление (создание экземпляра некоторого класса разрешает привязку для действий, выполняемых через этот экземпляр, а удаление – запрещает), – в дальнейшем автор по привычке будет использовать именно эту схему. Теоретически, дополнительное преимущество этой схемы в том, что код без изменений можно использовать и при отключении прямой привязки. Но фактически из-за дополнительных действий производительность будет хуже, чем при использовании Variant в обычном стиле – поэтому стоит ли это делать, не ясно. В любом случае, никаких различий с точки зрения подсистемы прямой привязки нет.

Принцип подмены команды вызова функции показан на рисунке 1. При вызове метода TVarBoost.VarAdd проверяется, разрешена ли прямая привязка. Этот метод должен быть объявлен невиртуальным, чтобы уменьшить затраты на вызовы и упростить порождаемый компилятором машинный код, осуществляющий эти вызовы. Если прямая привязка разрешена, рассматривается инструкция, вызвавшая метод. Ее исполнимый код содержит адрес метода (TVarBoost.VarAdd) – строго говоря, не адрес, а смещение от начала следующей инструкции до точки входа в метод, но это не принципиально.

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

Рисунок 1. Механизм подмены команды вызова.

При модификации кода следует проверить, действительно ли перед инструкцией, находящейся по адресу возврата из TGuard.Add, находится смещение TGuard.Add. Если это не так (или по какой-то странной причине не удается выполнить модификацию), можно сигнализировать об этом вызывающему коду генерацией исключения.

Если есть подозрение, что при следующем вызове тип аргументов изменится, нужно передать управление функции-анализатору (в примере – TVarBoost.VarAdd), которая при следующем вызове выполнит подстановку другой специализированной функции. Очевидно, для этого перед модификацией кода нужно сохранить информацию о том, по какому адресу и что планируется изменить, чтобы затем можно было восстановить изменяемый код в таком виде, какой он имел до осуществления привязки.

Следует заметить, что ощутимую выгоду от применения прямой привязки можно получить далеко не во всех случаях. Так, работа со строками или вызов через IDispatch вряд ли ощутимо ускорятся – ведь основная вычислительная нагрузка здесь создается самой обработкой значений, а не диспетчеризацией. Но некоторые действия, вероятно, имеет смысл ускорить – например, арифметические операции над целыми и вещественными операндами. Если же имеющаяся реализация ускорения не поддерживает операцию сложения для операндов таких типов, с которыми вызвана VarAdd, то подмена не выполняется. При этом никакого выигрыша от прямой привязки не будет, а накладные расходы на проверки и т.п. остаются – хотя, как показывает эксперимент, проигрыш не так уж и велик.

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

Пусть массив Arr содержит значения типа double, упакованные в Variant. Рассмотрим цикл:

Он выглядит достаточно безобидно. Однако если на первой итерации цикла в Sum хранится целочисленное значение, то на второй – уже вещественное! Кроме того, если функция, содержащая цикл, задумана как универсальная, вряд ли стоит рассчитывать, что 0 всегда будет адекватным начальным значением для аккумулятора: вдруг, например, массив состоит из текстовых строк?

Отчасти этих вредных эффектов можно избежать, выполнив:

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

Еще одна проблема – значения, переданные по ссылке (флаг varByRef в поле типа структуры TVarData). Результатом выполнения арифметической операции над Variant-значениями, переданными по ссылке, в Delphi является непосредственное Variant-значение. Следовательно, если в рассмотренном примере суммируются переданные по ссылке целые числа, то во втором, исправленном варианте цикла после первой же итерации тип аккумулятора изменится со ссылки на integer-значение (varInteger + varByRef) на непосредственное integer-значение (varInteger). Для этого, как это сделано в предлагаемом ниже тестирующем модуле, можно, помещая в аккумулятор копию первого элемента, выполнить копирование со снятием косвенности. Требуемые действия производит WinAPI-функция VariantCopyInd, по какой-то причине не объявленная в Delphi. Она экспортируется oleaut32.dll и может быть импортирована следующим объявлением:

Функция осуществляет копирование Variant-значения Src в Dest. При этом если значение в Src хранилось по ссылке, то в Dest оно будет непосредственным. Таким образом, цикл принимает такой вид:

Остается одна тонкость: VariantCopyInd правильно обрабатывает только OLE-совместимые Variant-значения. Такие расширения Delphi, как типы varString, varAny (еще одно расширение Variant, предназначенное для хранения значения Any из CORBA), эта функция обработать не сумеет. С другой стороны, простая проверка показывает, что, например, работать с varString, переданным по ссылке, не умеет работать и стандартный Variant-диспетчер Delphi; он понимает лишь «непосредственные» varString-значения (кавычки потому, что на самом деле такие значения все равно являются указателями). Будем уповать на то, что и varAny подчиняется этому же правилу (проверить у автора возможности нет) – или полагаться на то, что тип элементов массива Arr – не varAny. Тогда можно предложить следующий способ обхода проблемы:

Кроме того, поскольку предсказать поведение других типов данных, которые могут помещаться в Variant, например, Custom Variants, заранее невозможно, имеет смысл написать две версии логики функции – оптимизированную и стандартную. В начале работы функция проверяет тип исходных данных, и если он совпадает с одним из ожидаемых типов, то выполняется оптимизированная версия тела функции, в противном случае – вариант без оптимизации. Кроме того, такой подход позволит корректно обрабатывать ситуации, когда прямая привязка по той или иной причине оказалась невозможна:

Пример реализации

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

      unit VarBoost;
interfaceUses SysUtils, Windows, Classes;

Type
  EPatchingFailed = class (Exception)
    constructor CreateDetailedFmt(
      Location : string;
      PatchPoint : pointer;
      Fmt : string;
      Args : arrayofconst);
  end;

  EPatchingFailed_Cascaded = class (EPatchingFailed)
    constructor CreateDetailedFmt(
      Location : string;
      PatchPoint : pointer;
      Fmt : string;
      Args : arrayofconst;
      Cause :  Exception);
        reintroduce; overload; // Старый CreateDetailedFmt не прячемpublic
    Cause : Exception;
  end;

Type TVarOp = function (var A, B : Variant) : Variant ofobject;

Type
  TPatchRecord = record
    address : PDWORD;
    data : DWORD;
  end;
  PPatchRecord=^TPatchRecord;

  {$TypeInfo On}// для выяснения имен методов по адресам методов
  TVarBoost = classconstructor Create();
    destructor Destroy(); override;
    function VarAdd(var A, B : Variant) : Variant;
  private
    Patches : TList;
    // CalledProc используется для проверки - действительно ли// можно патчить или это был нестандартный вызовprocedure Patch(ReturnAddress : pchar; CalledProc, NewProc : TVarOp);

    function VarAdd_Default(var A, B : Variant) : Variant;
    function VarAdd_IntInt(var A, B : Variant) : Variant;
    function VarAdd_IntRInt(var A, B : Variant) : Variant;
    function VarAdd_RIntInt(var A, B : Variant) : Variant;
    function VarAdd_RIntRInt(var A, B : Variant) : Variant;
    function VarAdd_DoubleDouble(var A, B : Variant) : Variant;
    function VarAdd_DoubleRDouble(var A, B : Variant) : Variant;
    function VarAdd_RDoubleDouble(var A, B : Variant) : Variant;
    function VarAdd_RDoubleRDouble(var A, B : Variant) : Variant;
    function VarAdd_IntDouble(var A, B : Variant) : Variant;
    function VarAdd_IntRDouble(var A, B : Variant) : Variant;
    function VarAdd_RIntDouble(var A, B : Variant) : Variant;
    function VarAdd_RIntRDouble(var A, B : Variant) : Variant;
    function VarAdd_DoubleInt(var A, B : Variant) : Variant;
    function VarAdd_DoubleRInt(var A, B : Variant) : Variant;
    function VarAdd_RDoubleInt(var A, B : Variant) : Variant;
    function VarAdd_RDoubleRInt(var A, B : Variant) : Variant;
  end;
  {$TypeInfo Off}implementationuses variants;

constructor EPatchingFailed.CreateDetailedFmt(
      Location : string;
      PatchPoint : pointer;
      Fmt : string;
      Args : arrayofconst);
begininherited CreateFmt(Fmt, Args);
  Message := format(
  'TVarBoost.%s() :  Cannot patch the call instruction (with next instruction '
  + 'supposedly at %p).' + Message, [Location, PatchPoint]);
end;

constructor EPatchingFailed_Cascaded.CreateDetailedFmt(
      Location : string;
      PatchPoint : pointer;
      Fmt : string;
      Args : arrayofconst;
      Cause :  Exception);
begininherited CreateDetailedFmt(Location, PatchPoint, Fmt, Args);
  self.Cause := Cause;
end;

///////////////////function TVarBoost.VarAdd_Default(var A, B : Variant) : Variant;
begin
  result := A + B
end;

function TVarBoost.VarAdd_IntInt(var A, B : Variant) : Variant;
begin
  TVarData(result).VInteger := TVarData(A).VInteger + TVarData(B).VInteger;
  TVarData(result).VType := varInteger;
end;

function TVarBoost.VarAdd_IntRInt(var A, B : Variant) : Variant;
begin
  TVarData(result).VInteger := 
    TVarData(A).VInteger
    + PInteger(TVarData(B).VPointer)^;
  TVarData(result).VType := varInteger;
end;

function TVarBoost.VarAdd_RIntInt(var A, B : Variant) : Variant;
begin
  TVarData(result).VInteger := PInteger(TVarData(A).VPointer)^
    + TVarData(B).VInteger;
  TVarData(result).VType := varInteger;
end;

function TVarBoost.VarAdd_DoubleInt(var A, B : Variant) : Variant;
begin
  TVarData(result).VDouble := TVarData(A).VDouble + TVarData(B).VInteger;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_DoubleDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := TVarData(A).VDouble + TVarData(B).VDouble;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_DoubleRDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := TVarData(A).VDouble 
    + PDouble(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_DoubleRInt(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := TVarData(A).VDouble 
    + PInteger(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_IntDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := TVarData(A).VInteger + TVarData(B).VDouble;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_IntRDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := TVarData(A).VInteger 
    + PDouble(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RDoubleDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := 
    PDouble(TVarData(A).VPointer)^ + TVarData(B).VDouble;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RDoubleInt(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PDouble(TVarData(A).VPointer)^ 
    + TVarData(B).VInteger;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RIntDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PInteger(TVarData(A).VPointer)^ 
    + TVarData(B).VDouble;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RDoubleRDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PDouble(TVarData(A).VPointer)^ 
    + PDouble(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RDoubleRInt(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PDouble(TVarData(A).VPointer)^ 
    + PInteger(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RIntRDouble(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PInteger(TVarData(A).VPointer)^ 
    + PDouble(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

function TVarBoost.VarAdd_RIntRInt(var A, B :  Variant) :  Variant;
begin
  TVarData(result).VDouble := PInteger(TVarData(A).VPointer)^ 
    + PInteger(TVarData(B).VPointer)^;
  TVarData(result).VType := varDouble;
end;

//-----------------------------------------------------------constructor TVarBoost.Create();
begin
  Patches := TList.Create;
end;

destructor TVarBoost.Destroy();
var i : integer;
beginfor i := 0 to Patches.Count - 1 dowith PPatchRecord(Patches[i])^ do
      address^ := data;
  Patches.Free;
end;

procedure TVarBoost.Patch(ReturnAddress : pchar; CalledProc, NewProc : TVarOp);
var
  OldProtection : DWORD;
  PatchRecord : PPatchRecord;
  CalledMethod : String;
begin
  New(PatchRecord);
  PatchRecord^.address := PDWORD(ReturnAddress - 4);
  PatchRecord^.data := PatchRecord^.address^;
  CalledMethod := MethodName(@CalledProc);
  tryifnot VirtualProtect(ReturnAddress - 4, 4, PAGE_EXECUTE_READWRITE, 
        OldProtection) thenraise EPatchingFailed.CreateDetailedFmt(
        CalledMethod, pointer(ReturnAddress), 'VirtualProtect() failed', []);

    if PInteger(ReturnAddress - 4)^ <> int64(cardinal(@CalledProc))
        - cardinal(ReturnAddress) thenraise EPatchingFailed.CreateDetailedFmt(
        CalledMethod, pointer(ReturnAddress), 
        'The supposed call instruction is not a regular "CALL rel32"', []);
    PInteger(ReturnAddress - 4)^  := int64(cardinal(@NewProc))
      - cardinal(ReturnAddress);
    FlushInstructionCache(GetCurrentProcessId(), ReturnAddress - 4, 4);
    Patches.Add(PatchRecord);
  excepton E : Exception dobegin
        Dispose(PatchRecord);
        //защиту не восстанавливаем - простоты радиif E is EPatchingFailed thenraiseelseraise EPatchingFailed_Cascaded.CreateDetailedFmt(
            CalledMethod, pointer(ReturnAddress), 
            'Reason :  unexpected exception %s (exception object attached) '
            + 'with message "%s"', 
            [E.ClassName, E.Message], E);
      end;
  end;
end;

const
  JmpTable : packedarray [1..16] ofpackedrecordcase byte of
                 1 : (L, R : word; Target : pointer);
                 2 : (Key : cardinal; Target_ : pointer)
             end = 
  (
    (L : varInteger; R : varInteger; Target :  @TVarBoost.VarAdd_IntInt),
    (L : varInteger; R : varInteger + varByRef; 
       Target : @TVarBoost.VarAdd_IntRInt), 
    (L : varInteger; R : varDouble; Target :  @TVarBoost.VarAdd_IntDouble),
    (L : varInteger; R : varDouble + varByRef;
       Target :  @TVarBoost.VarAdd_IntRDouble), 
    (L : varInteger + varByRef; R : varInteger;
       Target :  @TVarBoost.VarAdd_RIntInt), 
    (L : varInteger + varByRef; R : varInteger + varByRef;
       Target :  @TVarBoost.VarAdd_RIntRInt), 
    (L : varInteger + varByRef; R : varDouble;
       Target :  @TVarBoost.VarAdd_RIntDouble), 
    (L : varInteger + varByRef; R : varDouble + varByRef;
       Target :  @TVarBoost.VarAdd_RIntRDouble), 
    (L : varDouble; R : varInteger;
       Target :  @TVarBoost.VarAdd_DoubleInt), 
    (L : varDouble; R : varInteger + varByRef;
       Target :  @TVarBoost.VarAdd_DoubleRInt), 
    (L : varDouble; R : varDouble;
       Target :  @TVarBoost.VarAdd_DoubleDouble), 
    (L : varDouble; R : varDouble + varByRef;
       Target :  @TVarBoost.VarAdd_DoubleRDouble), 
    (L : varDouble + varByRef; R : varInteger;
       Target :  @TVarBoost.VarAdd_RDoubleInt), 
    (L : varDouble + varByRef; R : varInteger + varByRef;
       Target :  @TVarBoost.VarAdd_RDoubleRInt), 
    (L : varDouble + varByRef; R : varDouble;
       Target :  @TVarBoost.VarAdd_RDoubleDouble), 
    (L : varDouble + varByRef; R : varDouble + varByRef;
       Target :  @TVarBoost.VarAdd_RDoubleRDouble)
 );

function TVarBoost.VarAdd(var A, B : Variant) : Variant;
var
  Proc : TVarOp;
  addr : pchar;
  Key : DWORD;
  i : integer;
begin
  Proc := VarAdd_Default;

  //Готовим ключ поиска в таблице переходов
  Key := pdword(@TVarData(B).VType)^ shl 16  + 
       pdword(@TVarData(A).VType)^ and $ffff;
  //Приведения типов нужны для того, чтобы обойтись без//ненужной медленной инструкции чтения неполного двойного//слова (movzx) при чтении поля VType (размером 2 байта)for i := low(JmpTable) to high(JmpTable) doif JmpTable[i].Key=Key thenbegin
        TMethod(Proc).Code := JmpTable[i].Target;
        break
      end;

  result := Proc(A, B);

  asm//Достаем из стека адрес возврата//К сожалению, в отличие от MS Visual C++, Delphi не предоставляет языкового,//не зависящего от компилятора средства для получения адреса возврата.//Приходится полагаться лишь на свой опыт и типичную структуру стекового//кадра
    mov eax, [ebp + 4]
    mov addr, eax
  end;
  Patch(addr, VarAdd, Proc);
end;

end.

Пример практического применения и оценка эффективности

Приведенный ниже код предназначен для решения сразу трех задач: во-первых, демонстрации состоятельности обсуждаемой темы и ее практической полезности; во-вторых, подтверждения работоспособности предложенной в предыдущем разделе реализации; в-третьих, оценки эффекта от прямой привязки при работе с Variant.

Функции Sum и Sum_std принимают массив значений типа Variant. Первая пытается провести вычисления с использованием прямой привязки (если это не удается, вызывает вторую), вторая – без нее.

Функция RDTSC служит для замера производительности. NewInt – вспомогательное средство для распределения в динамической памяти заданного значения типа integer, что используется в одном из тестов.

Всего тестов четыре: в первом данные массива имеют тип varInteger, во втором – тоже varInteger, но хранящиеся по ссылке (здесь и применяется NewInt), в третьем – varDouble и в четвертом – varString (при работе с которым в предложенной реализации прямая привязка не производится, но вследствие того, что вызывается диспетчер, функции сложения в Sum будет приводить к дополнительным затратам времени).

При тестировании оператору выводится для каждого теста время работы Sum и Sum_std, а также возвращенные ими результаты.

В результате тестирования на вычислительной системе в конфигурации AMD Athlon64 3000+, 512Мб PC3200 (свободно 320Mб), MS Windows 2003 Server, «чистая» система сразу после установки, уменьшение временных затрат при прямой привязке для первых трех тестов составило, соответственно, 81%, 89% и 83%. Четвертый тест показал, как и следовало ожидать, снижение производительности Sum по сравнению c Sum_std, однако не слишком значительное: около 10%.

      unit Test1;

interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1 :  TButton;
    procedure Button1Click(Sender :  TObject);
  end;

var
  Form1 :  TForm1;

implementation{$R *.dfm}Uses VarBoost;

function VariantCopyInd(var Dest, Src : Variant) : HRESULT;
  stdcall; external 'oleaut32.dll';

function Sum(var Values : arrayof Variant) : Variant;
...
// Текст функции Sum приведен ранее, в разделе «Причины и решения»)
...

function Sum_Std(var Values : arrayof Variant) : Variant;
var S : Variant; i : integer;
    VarBoost : TVarBoost;
begin
  result := Unassigned;
  if length(Values)=0 then exit;

  VarBoost := TVarBoost.Create;
  try
    S := Values[low(Values)];
    for i := low(Values) + 1 to high(values) do
      S := S + Values[i];
    result := S;
  finally
    VarBoost.Free;
  end;
end;

function RDTSC() : int64;
asm rdtsc end;

function NewInt(i : integer) : PInteger;
begin
  new(result);
  result^ := i;
end;

procedure TForm1.Button1Click(Sender :  TObject);
var i : integer;
    Time : int64;
    S : Variant;
    Arr : array [0..1000] of Variant;

  procedure DoTests(DataType : string);
  var i : integer; StdTime, VBTime : int64;
  begin
    Sum_Std(Arr);
    Sum(Arr);
    StdTime := 0; VBTime := 0;
    for i := 1 to 100 dobegin
        Time := RDTSC();
        S := Sum_Std(Arr);
        Inc(StdTime, RDTSC() - Time);
        Time := RDTSC();
        S := Sum(Arr);
        Inc(VBTime, RDTSC() - Time);
      end;
    ShowMessage(Datatype + ', standard :  ' + String(Sum_Std(Arr)) + #13'Time :  ' + inttostr(StdTime div 100));
    ShowMessage(DataType + ', VarBoost :  ' + String(Sum(Arr)) + #13'Time :  ' + inttostr(VBTime div 100));
  end;

begin// Тесты для varIntegerfor i := 0 to 1000 do Arr[i]  := i;
  DoTests('Integer');

  // Проверка правильности восстановления  - //  вызов для другого типа//Тесты для varInteger + varByReffor i := 0 to 1000 dobegin
      TVarData(Arr[i]).VType := varInteger + varByRef;
      TVarData(Arr[i]).VPointer := NewInt(i);
    end;
  DoTests('Integer + ByRef');
  for i := 0 to 1000 do Dispose(TVarData(Arr[i]).VPointer);

  // Тесты для varDoublefor i := 0 to 1000 do Arr[i] := i/1000;
  DoTests('Double');

  // Тесты для varString (неподдерживаемый тип)for i := 0 to 1000 do Arr[i] := chr(i mod 10 + 48);
  DoTests('String');
end;

end.

Таким образом, можно сделать вывод, что использование Variant для написания обобщенных алгоритмов и выполнения некоторых видов вычислений не так безнадежно, как может показаться с первого взгляда.

Ускоренная обработка данных типа Variant в Delphi

Ускорение динамической диспетчеризации вызовов в статически типизированных языках на примере работы с Variant в Delphi

Автор: Maksim Gumerov
Источник: RSDN Magazine #4-2004

Опубликовано: 18.03.2005
Исправлено: 10.12.2016
Версия текста: 1.0

Введение в проблему

Причины и решения

Пример реализации

Пример практического применения и оценка эффективности

Ссылки

Ускоренная обработка данных типа Variant в Delphi

Ускорение динамической диспетчеризации вызовов в статически типизированных языках на примере работы с Variant в Delphi

Автор: Maksim GumerovИсточник: RSDN Magazine #4-2004

Опубликовано: 18.03.2005Исправлено: 10.12.2016Версия текста: 1.0

Введение в проблему

Причины и решения

Пример реализации

Пример практического применения и оценка эффективности

Ссылки

Автор: Maksim Gumerov
Источник: RSDN Magazine #4-2004

Опубликовано: 18.03.2005
Исправлено: 10.12.2016
Версия текста: 1.0