Share Next Entry
Быстрый WideString
Dignat
dignatyev

 

Быстрый WideString

 

Как ускорить производительность операций с WideString в Delphi?

 

1. Теория.

 

В Delphi есть удобный механизм для работы со строковыми данными. Для этого есть несколько типов строковых переменных: AnsiString, WideString и UnicodeString. Они удобны тем, выполняя операции присваивания и конкатенации, компилятор за нас сам выделяет или освобождает память под строки, а также автоматически преобразует один тип данных в другой.

AnsiString и UnicodeString – это внутренний формат представления строки в Delphi. Для выделения памяти под строку используется собственный очень производительный менеджер памяти. Также при копировании строк используется подсчет ссылок, без перераспределения памяти. Таким образом, компилятор генерирует максимально производительный код.

WideStringэто неявный формат BSTR и является стандартным строковым типом в COM/DCOM. Это его основное достоинство. Недостатком является отсутствие подсчета ссылок. Компилятор неявно использует API-функции при операциях с данными этого типа. Поэтому операции с WideString очень медленны.

По ряду объективных причин многие проекты пишутся на старых версиях Delphi, в которых нет быстрых UnicodeString. А поддержка юникода необходима, вот и приходится использовать WideString.

 

2. Практика.

Организуем в WideString поддержку подсчета ссылок, так чтоб и нашей программе было хорошо и объектам COM/DCOM в нашем приложении. Компилятор – Delphi 2007.

Для этого необходимо подменить ряд функций в system.pas. И самим выделять память, копировать и уничтожать строковые данные. Достаточно будет таких функций:

function _NewWideString(CharLength: Longint): Pointer;
procedure _WStrClr(var S);
procedure _WStrArrayClr(var StrArray; Count: Integer);
procedure _WStrAsg(var Dest: WideString; const Source: WideString);
procedure _WStrLAsg(var Dest: WideString; const Source: WideString);
procedure _WStrFromPWCharLen(var Dest: WideString; Source: PWideChar; CharLength: Integer);
procedure _WStrFromWChar(var Dest: WideString; Source: WideChar);
procedure _WStrFromPWChar(var Dest: WideString; Source: PWideChar);
function _WStrAddRef(var str: WideString): Pointer;

Можно конечно вписать в них свой код и откомпилировать system.pas, но пойдем более универсальным путем. Выполним перехват этих функций.
Для совместимости с COM/DCOM также перехватим:

function SysAllocString(psz: POleStr): TBStr; stdcall;
procedure SysFreeString(bstr: TBStr); stdcall;
function SysReAllocString(var bstr: TBStr; psz: POleStr): Integer;
function SysAllocStringLen(psz: POleStr; len: Integer): TBStr;
function SysReAllocStringLen(var bstr: TBStr; psz: POleStr; len: Integer): Integer;
function SysAllocStringByteLen(psz: PChar; len: Integer): TBStr; stdcall;


В WideString есть структура, в ней хранится длина строки в байтах. Эта структура размещена в памяти непосредственно перед данными строки. Создадим свою структуру, в которой кроме длины будем хранить счетчик ссылок и специальный идентификатор, чтоб отличать наши строки от всех прочих юникодных строк. Думаю, что длины в 12 байт вполне хватит для идентификатора.


type
  PWideStr = ^TWideStr;

  TWideStr = record

    refcnt : integer; //счетчик ссылок

    id0    : integer; //наш идентификатор

    id1    : integer; //наш идентификатор

    id2    : integer; //наш идентификатор

    length : integer; //размер строки (как и положено)

end;

const
  size_str = sizeof(TWideStr); 

  str_id_0 = integer($96969696);

  str_id_1 = integer($75757575);

     str_id_2 = integer($38383838);
 

Инициализации строки
function doWStrAlloc(len: Integer): PWideStr; inline;
begin
  GetMem(result, size_str + len + 2);
  result.refcnt := 1;
  result.Id0 := str_id_0;
  result.Id1 := str_id_1;
  result.Id2 := str_id_2;
  result.length := len;
  PWideChar(@PAnsiChar(result)[size_str+len])^ := #0;
end;

 Освобождение строки

procedure doWStrFree(s: PWideStr); inline;
begin
  if (s.Id2 = str_id_2) and
     (s.Id1 = str_id_1) and
     (s.Id0 = str_id_0)
  then
  if InterlockedDecrement(s.refcnt) = 0 then
  FreeMem(s);
end;

 procedure WStrFree(s: PWideStr); inline;
begin

  if Assigned(s) then begin

    Dec(s);

    if (s.Id2 = str_id_2) and

       (s.Id1 = str_id_1) and

       (s.Id0 = str_id_0)

    then

    if InterlockedDecrement(s.refcnt) = 0 then

    FreeMem(s);

  end;

end;


Копирование строки

function doWStrCopy(s: PWideStr): PWideStr; inline;
begin
  if (s.Id2 = str_id_2) and
     (s.Id1 = str_id_1) and
     (s.Id0 = str_id_0)
  then begin
    InterlockedIncrement(s.refcnt);
    result := s;
  end
  else begin
    result := doWStrAlloc(s.length);
    Move(PAnsiChar(s)[size_str], PAnsiChar(result)[size_str], s.length);
  end;
end;

 function WStrCopy(s: PWideStr): PWideStr; inline;
begin

  if s = nil then

    result := nil

  else begin

    Dec(S);

    if (s.Id2 = str_id_2) and

       (s.Id1 = str_id_1) and

       (s.Id0 = str_id_0)

    then begin

      InterlockedIncrement(s.refcnt);

      result := @PAnsiChar(s)[size_str];

    end

    else begin

      result := @PAnsiChar(doWStrAlloc(s.length))[size_str];

      Move(PAnsiChar(s)[size_str], result^, s.length);

    end;

  end;

end;


function WStrLCopy(s: PWideStr; len: integer): PWideStr; inline;
begin

  result := doWStrAlloc(len);

  Inc(result);

  if Assigned(s) then

    Move(s^, result^, len);

end;


А вот процедуры для подмен (system.pas)

function xWStrClr(var S: PWideStr): PWideStr;
begin
  result := @S;
  WStrFree(s);
  S := nil;
end;

procedure xWStrAsg(var Dest: PWideStr; Source: PWideStr);
var

  t   : PWideStr;

begin

  t := Dest;

  if t <> Source then begin

    WStrFree(t);

    if Source = nil then

      Dest := nil

    else begin

      Dec(Source);

      t := doWStrCopy(Source);

      Dest := @PAnsiChar(t)[size_str];

    end;

  end;

end;


function xWStrAddRef(var s: PWideStr): Pointer;
begin

  result := WStrCopy(s);

end;


procedure xWStrArrayClr(s: PPWideStr; Count: Integer);
var

  t : PWideStr;

begin

  while Count > 0 do begin

    t := s^;

    WStrFree(t);

    Inc(s);

    Dec(count);

  end;

end;


 

procedure xWStrFromPWCharLen(var Dest: PWideStr; Source: PWideStr; Len: Integer);
begin

  WStrFree(Dest);

  Dest := WStrLCopy(Source, Len*2);

end;
 

procedure xWStrFromWChar(var Dest: PWideStr; Source: WideChar);
var

  t : PWideStr;

begin

  if (Dest = nil) or (PWideChar(Dest)^ <> Source) then begin

    WStrFree(Dest);

    t := doWStrAlloc(2);

    Inc(t);

    Move(Source, t^, 2);

    Dest := t;

  end;

end;


 

procedure xWStrFromPWChar(var Dest: PWideStr; Source: PWideStr);
var

  t : PWideStr;

begin

  t := WStrLCopy(Source, WStrSize(PWideChar(Source)));

  WStrFree(Dest);

  Dest := t;

end;

function xNewWideString(Len: Longint): PWideStr;
begin

  result := doWStrAlloc(Len*2);

  Inc(result);

end;


Процедуры для подмен (oleaut32.dll)

procedure xSysFreeString(s: PWideStr); stdcall;
begin
  WStrFree(s);
end;

 function xSysAllocString(s: PWideStr): PWideStr; stdcall;
begin

  result := WStrLCopy(s, WStrSize(PWideChar(s)));

end;
 

function xSysAllocStringLen(s: PWideStr; len: Integer): PWideStr; stdcall;
begin

  result := WStrLCopy(s, len * 2);

end;

 function  xSysAllocStringByteLen (s: pointer; len: Integer): PWideStr; stdcall;
begin

  result := WStrLCopy(s, len);

end;

 function xSysReAllocStringLen(var p: PWideStr; s: PWideStr; len: Integer): LongBool; stdcall;
begin

  if s <> p then begin

    WStrFree(p);

    p := WStrLCopy(s, len * 2);

  end;

  result := true;

end;
 

Перехватывать функции будет методом сплайсинга. Это когда в начало кода перехватываемой функции вставляем переход на нашу функцию. Обычно это команда jmp offset.

 type
  POffsJmp = ^TOffsJmp;
  TOffsJmp = packed record

    code : byte;     //$E9

    offs : cardinal;

  end;

 procedure HookCode(Src, Dst: pointer); inline;
begin

  if Assigned(Src) then begin

    poffsjmp(Src).code := $E9;

    poffsjmp(Src).offs := cardinal(Dst) - cardinal(Src) - 5;

  end;

end;


procedure HookProc(handle: cardinal; Name: PAnsiChar; Hook: pointer); inline;
begin

  HookCode(GetProcAddress(handle, Name), Hook);

end;

 Так мы узнаем адреса функций в system.pas:


function pWStrClr: pointer;
asm

  mov eax, OFFSET System.@WStrClr

end;

function pWStrAddRef: pointer;
asm

  mov eax, OFFSET System.@WStrAddRef

end;

 
function pWStrAsg: pointer;

asm

  mov eax, OFFSET System.@WStrAsg

end;

function pWStrLAsg: pointer;
asm

  mov eax, OFFSET System.@WStrLAsg

end;

function pWStrArrayClr : pointer;
asm

  mov eax, OFFSET System.@WStrArrayClr

end;
 

function pWStrFromPWCharLen : pointer;
asm

  mov eax, OFFSET System.@WStrFromPWCharLen

end;
 

function pWStrFromWChar : pointer;
asm

  mov eax, OFFSET System.@WStrFromWChar

end;

 function pWStrFromPWChar : pointer;
asm

  mov eax, OFFSET System.@WStrFromPWChar

end;

 function pNewWideString : pointer;
asm

  mov eax, OFFSET System.@NewWideString

end;
 

Код перехвата.

procedure FastWideStringInit;
var
  handle  : cardinal;
  protect : cardinal;
  mem     : TMemoryBasicInformation;
begin
  VirtualQuery(pWStrAddRef, mem, sizeof(mem));
  VirtualProtect(mem.AllocationBase, mem.RegionSize, PAGE_EXECUTE_READWRITE, protect);
  HookCode(pWStrClr,           @xWStrClr);
  HookCode(pWStrAsg,           @xWStrAsg);
  HookCode(pWStrLAsg,          @xWStrAsg);
  HookCode(pWStrAddRef,        @xWStrAddRef);
  HookCode(pWStrArrayClr,      @xWStrArrayClr);
  HookCode(pWStrFromPWCharLen, @xWStrFromPWCharLen);
  HookCode(pWStrFromWChar,     @xWStrFromWChar);
  HookCode(pWStrFromPWChar,    @xWStrFromPWChar);
  HookCode(pNewWideString,     @xNewWideString);
  VirtualProtect(mem.AllocationBase, mem.RegionSize, protect, protect);
 

  handle := GetModuleHandle(oleaut);
  if handle = 0 then

    handle := LoadLibrary(oleaut);

  VirtualQuery(GetProcAddress(handle, 'SysAllocString'), mem, sizeof(mem));
  VirtualProtect(mem.AllocationBase, mem.RegionSize, PAGE_EXECUTE_READWRITE, protect);

  HookProc(handle, 'SysAllocString',        @xSysAllocString);

  HookProc(handle, 'SysAllocStringLen',     @xSysAllocStringLen);

  HookProc(handle, 'SysAllocStringByteLen', @xSysAllocStringByteLen);

  HookProc(handle, 'SysReAllocStringLen',   @xSysReAllocStringLen);

  HookProc(handle, 'SysFreeString',         @xSysFreeString);

  VirtualProtect(mem.AllocationBase, mem.RegionSize, protect, protect);

end;

 


 

3. Тестирование.

 

Для тестирования возьмем объект TWideStringList из WideStrings.pas. У него есть свойство

property Text: WideString read GetTextStr write SetTextStr. Если присвоить ему текст большого размера, то получим представление об увеличении производительности. Для этого я загрузил в память содержимое файла windows.pas и засек время,необходимое для выполнения GetTextStr () и SetTextStr(). Тестировал до и после инициализации быстрых WideString.


Прирост скорости составил 80 % от начального. Достаточно заметно.


const
  rep_count := 40;


procedure TestWideString(var s: widestring);
var

  i : integer;

begin

  with TWideStringList.Create do

  try

    for i := 0 to rep_count do begin

      Text := s;

      s := Text;

    end;

  finally

    Free;

  end;

end;

 
 

4. Подводные камни.


 

Многие программисты знают, что при копировании WideString, под новую строку выделяется новая память. Поэтому они могут свободно модифицировать содержимое новой строки, не боясь, что это повлияет на первоначальную строку.

 

Рассмотрим следующий пример.

 const
  shlwapi32 = 'SHLWAPI.DLL';


function PathRemoveFileSpecW(pszPath: PWideChar): BOOL; stdcall; external shlwapi32; 

function PathRemoveFileSpec(s: WideString): WideString;
begin

  result := s;

  if PathRemoveFileSpecW(PWideChar(result)) then

    result := PWideChar(result);

end;

var
  a : widestring;

  b : widestring;

begin

  a := 'c:\myfolder\myfile.txt';

  b := PathRemoveFileSpec(a);

end;


Функция PathRemoveFileSpecW() если удачно отработает, модифицирует строку 'c:\myfolder\myfile.txt'  на 'c:\myfolder'#0'myfile.txt';  В итоге переменная b будет равна 'c:\myfolder' А переменная a, как была 'c:\myfolder\myfile.txt',  так и осталась. То, что мы ожидали увидеть.


В случае с включенным режимом подсчета ссылок при присваивании result := s, переменные result, s и а ссылаются на одну и ту же память со строкой. При присваивании у нас всего лишь увеличился счетчик ссылок. Что же произойдет после выполнения функции PathRemoveFileSpecW()? Она модифицирует одну и туже строку, на которую ссылаются все эти переменные. В итоге b = 'c:\myfolder', а = 'c:\myfolder'#0'myfile.txt'. Вот это мы не ожидали. Если значение переменной a использовать в дальнейших операциях, то это приведет к непредсказуемым результатам.


Как тут быть? Да очень просто. Нужно копировать полностью строку, например вот так: b := PathRemoveFileSpec(a + '') или result := s + ''. Такая инструкция заставит компилятор сгенерировать код, который полностью копирует строку.

function PathRemoveFileSpec(s: WideString): WideString;
begin
  result := s + '';
  if PathRemoveFileSpecW(PWideChar(result)) then
    result := PWideChar(result);
end;

Так как подобные случаи не так часто встречаются, то найти и подправить нужный код проекта не составит труда.


 

5. Исходные коды.

 


 

 


?

Log in