Совсем нетрудно написать на Delphi простейший цикл, реализующий замену символов в Ansi-строке. Только есть одна проблема - это будет медленный цикл.

Уникальность строки

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

Обычно используют известный способ обхода автоматических проверок - один раз вручную вызывают UniqueString (или SetLength, или Setstring) и далее работают с символами строки через указатель.

Блоки данных

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

Чтобы уменьшить количество операций записи можно попытаться сначала целиком скопировать строку в результат функции, а затем уже в нем выполнить замены. Но это половинчатое решение.

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

Ветвление программы

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

Возможности процессора

Некоторые возможности процессора, например, поддержка набора инструкций SSE2, могут сильно облегчить написание быстрого кода. Однако чтобы ими воспользоваться, потребуется реализовать дополнительные проверки и процедуры. Не все инструкции одинаково полезны, например, инструкция PCMPESTRM из набора SSE4.2 моих надежд не оправдала. Вы можете поиграть с ней, если скачаете прилагаемый исходник.

Специальные случаи

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

Ну почему все так сложно

Потому что не все описанные идеи легко реализовать. Это видно на примере функции замены одного символа на другой.

function ShaCharReplace(const s: AnsiString; chFrom, chTo: AnsiChar): AnsiString;
var
  ch1, ch2, chf, cht, len: integer;
  p, q: pInteger;
  ch: AnsiChar;
label
  loop, last;
begin;
  len:=Length(s);
{$ifdef UnderFastMM}
  Result:='';
{$else}
  if IsMMChanged then Result:='';
{$endif}
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  chf:=ord(chFrom) * $01010101;
  cht:=ord(chTo)   * $01010101 xor chf;
  if (len>31) and IsSSE2Supported then begin;
    SSEReplace(p, q, chf, cht);
    inc(pChar(p), len and -32);
    inc(pChar(q), len and -32);
    len:=len and 31;
    end;
  chf:=chf xor integer($FFFFFFFF);
  while len>3 do begin;
    ch1:=p^;
    ch2:=ch1 xor chf;
    ch2:=(ch2 and $7F7F7F7F + $01010101) and $80808080 and ch2;
    q^:=(ch2 - ch2 shr 7 or ch2) and cht xor ch1;
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    ch:=pAnsiChar(p)[len];
    if ch=chFrom then ch:=chTo;
    pAnsiChar(q)[len]:=ch;
    end;
  end;

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

На следующем шагу алгоритма вызов SetLength устанавливает новую длину строки и счетчик ссылок, соответствующий уникальной строке.

Дальнейшие операции со строками выполняются блоками по 4 байта через указатели на целое p и q. Исключением является обработка не кратного четырем байтам хвоста строки в самом конце функции.

Давайте пока пропустим вызов процедуры SSEReplace и обратимся к самому интересному в этой функции - обработке 4-символьного блока данных, которая выполняется без распаковки блока данных и без ветвлений.

Общая идея такова. Пусть требуется превратить блок МАМА в блок ПАПА, заменив в нем буквы М на П. Для этого предварительно вычислим несколько значений-шаблонов: ММММ и ПППП - это наши символы, повторенные 4 раза, и XXXX:=ММММ XOR ПППП. В шестнадцатеричном виде им соответствуют следующие значения МАМА=$CCC0CCC0, ПАПА=$CFC0CFC0, ММММ=$CCCCCCCC, ПППП=$CFCFCFCF, XXXX=$03030303. Заметим, что на самом деле в процессорах x86 используется обратный порядок следования байтов, но на суть изложения это не влияет.

Если бы существовал магический способ определить места вхождения символов М в блок МАМА, прикладывая к нему шаблон ММММ, мы могли бы получить в результате этой магии значение $FF00FF00, в котором изменяемым символам соответствует $FF, а неизменяемым $00. Затем мы могли бы логически умножить полученное значение на XXXX=$03030303 и получить $03 в нужных местах: $03000300. И, наконец, мы могли бы логически сложить последнее значение с блоком МАМА=$CCC0CCC0 и получить блок ПАПА=$CFC0CFC0.

В алгоритме вся магия реализована в преобразованиях переменной ch2, а полученное магическое значение $FF00FF00 используется финальными AND и XOR для формирования результирующего блока.

Если вам уже наскучило описание применения шестнадцатеричной системы счисления для обработки символьных данных, пропустите этот абзац. Для остальных раскроем секреты волшебства. Первый же XOR внутри цикла дает нам почти то, что нужно. На местах замен мы получаем $FF, а в остальных байтах результат будет отличаться от $FF, но не обязательно там будут $00, как нам хотелось бы. Цель дальнейших действий - обнулить эти грязные байты. Трюк состоит в том, что мы после предварительного обнуления старшего бита каждого байта добавляем 1 к каждому байту и затем логически умножаем старший бит результата сложения на прежнее значения старшего бита (до обнуления). Понятно, что в результате этих манипуляций будет получена 1 в старшем бите только для байтов, имевших значение $FF, поэтому нам остается лишь размножить старший бит каждого байта на остальные биты.

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

Оказывается, парни в Intel хорошо чувствуют потребности программистов и реализовали нашу магию в специальной инструкции сравнения упакованных данных PCMPEQB, которая используется внутри процедуры SSEReplace. Ну, вы и сами уже догадались.

procedure SSEReplace(p, q: pointer; chf, cht: integer);
asm
  movd    xmm0, ecx
  movd    xmm1, cht
  mov     ecx, [eax-4]
  and     ecx, -32
  pshufd  xmm0, xmm0, 0
  pshufd  xmm1, xmm1, 0
@@loop:
  movdqu  xmm2, [eax]
  movdqu  xmm3, [eax + 16]
  movdqa  xmm4, xmm2
  movdqa  xmm5, xmm3
  pcmpeqb xmm2, xmm0
  pcmpeqb xmm3, xmm0
  pand    xmm2, xmm1
  pand    xmm3, xmm1
  pxor    xmm2, xmm4
  pxor    xmm3, xmm5
  movdqu  [edx], xmm2
  movdqu  [edx + 16], xmm3
  add     eax, 32
  add     edx, 32
  sub     ecx, 32
  jg      @@loop
  end;

Дальше будет проще

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

function ShaCharReplace(const s: AnsiString; pCharReplaceTable: pByteArray): AnsiString;
var
  len: integer;
  p, q: pInteger;
begin;
  len:=Length(s);
{$ifdef UnderFastMM}
  Result:='';
{$else}
  if IsMMChanged then Result:='';
{$endif}
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  while len>3 do begin;
    q^:=pCharReplaceTable[p^ shr 24        ] shl 24
     or pCharReplaceTable[p^ shr 16 and 255] shl 16
     or pCharReplaceTable[p^ shr  8 and 255] shl  8
     or pCharReplaceTable[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    pByteArray(q)[len]:=pCharReplaceTable[pByteArray(p)[len]];
    end;
  end;

Правда, предварительно придется заполнить таблицу замен длиной 256 байт приведенной процедурой.

 
procedure ShaCharReplaceTableInit(const FromChars, ToChars: AnsiString; pCharReplaceTable: pByteArray);
var
  i, len: integer;
begin;
  for i:=0 to 255 do pCharReplaceTable[i]:=i;
  i:=Length(FromChars);
  len:=Length(ToChars);
  if len>i then len:=i;
  for i:=1 to len do pCharReplaceTable[ord(FromChars[i])]:=ord(ToChars[i]);
  end;

А не пора ли нам

Достигнутое наводит на мысль использовать табличную замену для ускорения функций AnsiUpperCase и AnsiLowerCase. Конечно, ускорение в 5..9 раз вряд ли заинтересует рядового программиста. А вот если вы индексируете целые библиотеки, то для увеличения скорости преобразования имеет смысл даже жестко запаять в коде оптимизацию для любимых кодовых страниц, чтобы обеспечить для них ускорение 15..25 раз, как это сделано в функциях ShaAnsiUpperCase и ShaAnsiLowerCase.

function ShaAnsiUpperCase(const s: AnsiString): AnsiString;
var
  len: integer;
  p, q: pInteger;
begin;
  if AnsiLocaleID<>GetThreadLocale then begin;
    Result:=AnsiUpperCase(s);
    exit;
    end;
  len:=Length(s);
{$ifdef UnderFastMM}
  Result:='';
{$else}
  if IsMMChanged then Result:='';
{$endif}
  SetLength(Result, len);
  p:=pointer(s);
  q:=pointer(Result);
  if (len>31) and (@SSEUpper<>nil) then begin;
    SSEUpper(p, q);
    inc(pChar(p), len and -32);
    inc(pChar(q), len and -32);
    len:=len and 31;
    end;
  while len>3 do begin;
    q^:=pByteArray(AnsiToUpperTable)[p^ shr 24        ] shl 24
     or pByteArray(AnsiToUpperTable)[p^ shr 16 and 255] shl 16
     or pByteArray(AnsiToUpperTable)[p^ shr  8 and 255] shl  8
     or pByteArray(AnsiToUpperTable)[p^        and 255];
    inc(p);
    inc(q);
    dec(len,4);
    end;
  while len>0 do begin;
    dec(len);
    pByteArray(q)[len]:=pByteArray(AnsiToUpperTable)[pByteArray(p)[len]];
    end;
  end;

Полный исходный код всех функций доступен для скачивания.

Благодарю участников форума SQL.RU за их настойчивость и подсказки.

на главную