Быстрые WideString в Delphi
Ускоряем операции со строками
Немного теории
В Delphi есть удобный механизм для работы со строковыми данными. Для этого есть несколько типов строковых переменных: AnsiString, WideString и UnicodeString. Они удобны тем что, в операциях присваивания и конкатенации, компилятор генерирует код, который неявно выделяет или освобождает память под строки, а также автоматически преобразует один тип данных в другой.
AnsiString и UnicodeString – это внутренний формат представления строки в Delphi. Для выделения памяти под строку используется собственный, очень производительный менеджер памяти. Также, при копировании строк используется подсчет ссылок без перераспределения памяти. Таким образом, компилятор генерирует максимально производительный код.
WideString – это неявный формат BSTR и является стандартным строковым типом в COM/DCOM. Это его основное достоинство. Недостатком является отсутствие подсчета ссылок. Компилятор неявно использует API-функции при операциях с данными этого типа. Поэтому операции с WideString очень медленны.
По ряду объективных причин многие проекты пишутся на старых версиях Delphi, в которых нет быстрых UnicodeString. А поддержка юникода необходима, вот и приходится использовать WideString.
Внедряем механизм подсчета ссылок
В WideString есть структура, в ней хранится длина строки в байтах. Эта структура размещена в памяти непосредственно перед данными строки. Для выделения и освобождения памяти под строку вместо системных API-функций будем использовать собственный менеджер памяти. При этом мы сами можем определить структуру, добавив все необходимые поля. Добавим счетчик ссылок и специальный идентификатор, чтоб отличать строки созданные нами от всех других строк.
type
PWideStr = ^TWideStr;
TWideStr = record
refcnt : integer; //счетчик ссылок
id0 : integer; //наш идентификатор
id1 : integer; //наш идентификатор
id2 : integer; //наш идентификатор
length : integer; //размер строки (как и положено)
end;
const
str_id_0 = integer($96969696);
str_id_1 = integer($75757575);
str_id_2 = integer($38383838);
size_str = sizeof(TWideStr);
Данная структура удовлетворяет условию, что длина строки должна быть непосредственно перед самой строкой.
Идентификатор нужен, чтоб мы могли отличать нашу строку от других строк. Только так мы можем знать, для каких строк можно использовать подсчет ссылок.
В 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;
Можно заменить код этих функций, а можно в режиме выполнения программы перехватить их и выполнить свои функции. Второй метод более универсален, поэтому и выберем его.
Чтоб не было проблем с 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;
Базовые функции.
Их всего три типа: выделение памяти, освобождение памяти и копирование строки.
//Инициализация строки.
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;
Для инициализации нашего механизма достаточно вызвать FastWideStringInit(). И чем раньше, тем лучше.
Тестирование
Для тестирования нужен код, в который в основном состоит из операций со строками. Под рукой оказалась часто используемая библиотека WideStrings.pas. Там есть замечательный класс TWideStringList. А в нем свойство
property Text: WideString read GetTextStr write SetTextStr;
Засечем время выполнения TWideStringList.GetTextStr() и TWideStringList.SetTextStr() до и после инициализации быстрых WideString. Вот часть кода.
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;
Прирост скорости составляет около 80%. И это только за счет механизма подсчета ссылок.
Подводные камни
Рассмотрим по шагам следующий пример.
procedure Test1;
var
s1, s2 : WideString;
begin
s1 := 'test'; // 1
s2 := s1; // 2
s2[1] := 'b'; // 3
end;
1. Присваивая s1 := ‘test’, выделяем память.
2. Присваивая s2 := s1, выделяем память.
3. Меняем значение первого символа s2[1] := ‘b’. В итоге s2 = ‘best’, а s1 = ‘test’.
А что будет, когда включим подсчет ссылок?
procedure Test2;
var
s1, s2 : WideString;
begin
FastWideStringInit; // 1
s1 := 'test'; // 2
s2 := s1; // 3
s2[1] := 'b'; // 4
end;
4. Инициализируем быстрые WideString
5. Присваивая s1 := ‘test’, выделяем память.
6. Присваивая s2 := s1, мы только увеличиваем счетчик. s2 указывает на тот же участок памяти, что и s1.
7. Меняем значение первого символа s2[1] := ‘b’. В итоге s2 = ‘best’, и s1 = ‘best’.
Вот этого мы и не ожидали.
Рассмотрим реальный пример из жизни и вариант его решения.
const
shlwapi32 = 'SHLWAPI.DLL';
{ Функция выделяет путь из имени файла, путем замены последующего за путем символа на #0 }
function PathRemoveFileSpecW(pszPath: PWideChar): BOOL; stdcall; external shlwapi32;
{ А это наша удобная обвертка }
function MyPathRemoveFileSpec(s: WideString): WideString;
begin
result := s;
if PathRemoveFileSpecW(PWideChar(result)) then
result := PWideChar(result);
end;
var
a : widestring;
b : widestring;
begin
FastWideStringInit;
a := 'c:\myfolder\myfile.txt';
b := MyPathRemoveFileSpec(a);
end;
Функция PathRemoveFileSpecW() если удачно отработает, модифицирует строку result 'c:\myfolder\myfile.txt' на 'c:\myfolder'#0'myfile.txt';
Операция result := PWideChar(result) выделит новую память, и скопирует в нее 'c:\myfolder'.
В итоге, b = 'c:\myfolder', а = 'c:\myfolder'#0'myfile.txt'.
Переменная a испорчена и если ее использование дальше приведет к неопределенным ситуациям. А все потому, что на момент выполнения PathRemoveFileSpecW() переменные a, s и result указывали на одну и туже строку в памяти. Значит, нам надо уметь копировать без использования подсчета ссылок. А делается это просто, вот так.
function MyPathRemoveFileSpec(s: WideString): WideString;
begin
result := s + ''; //при конкатинации всегда содается новая копия строки
if PathRemoveFileSpecW(PWideChar(result)) then
result := PWideChar(result);
end;
Данная реализация функции будет работать без вышеописанной проблемы.
Примечания
Данный код писался на Delphi 2007. Для других версий, возможно, придется код немного модифицировать. Это касается инструкций inline и названий функций из system.pas.
Замете, деинициализации механизма нет. Если он запущен, то должен работать до конца, пока есть последняя WideString в памяти. Также желательно, чтоб инициализация была как можно раньше. Например, разместите в секции initialization того юнита, который раньше всех будет инициализироваться.
