Почему в delphi блок case работает медленно и как это исправить.

Делюсь способами оптимизации и хаками.

Почему case плох

Даже начинающие delphi-программисты знают как выглядит блок case. Однако не все знают, что для нашего процессора, он выглядит как множество if блоков.

Вот что видит программист:

procedure case_test(Index:Integer);
begin
  case Index of
    0: writeln('Hello');
    1: writeln('Habr!');
  end;
end;

А вот что видит процессор:

procedure case_test(Index:Integer);
begin
  Index:=0;
  if Index = 0 then 
    writeln('Hello')
  else    
  if Index = 1 then 
    writeln('Habr!');
end;

К сожалению никакой магии за словом case не оказалось. Более того, слишком активное использование case может замедлить выполнение кода. Например если у Вас не 2 варианта проверок, а 50, 250 или ещё больше. Худшим решением для вас будет блок case.

Чем заменить case

Решение у этой проблемы есть. Само строение блока case подсказывает нам, что наши варианты должны быть достаточно прибраны, чтобы поместиться в перечисляемом типе данных например: Integer, Word, Byte, Enum или Char.

В случае когда мы используем индекс для обращения к данным через case — всё просто. Вам необходимо записать данные в массив и подставлять индекс не в case, а в массив.

const 
  Data:Array[0..1] of String = ('Hello', 'Habr!');

procedure case_test(Index:Integer);
begin  
  writeln(Data[Index]);
end;

Это работает когда в действиях внутри блока case меняется только один параметр. Но что делать если параметров несколько?

Чем заменить сложный case

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

type
  TMyTextWord = record
    Text:String;
    NeedLinebreak:Boolean;
  end;

const
  Data:Array[0..2] of TMyTextWord = ( 
    (Text:'Hello'; NeedLinebreak:False), 
    (Text:' '; NeedLinebreak:False), 
    (Text:'Habr!'; NeedLinebreak:True) 
  );

procedure case_test(Index:Integer);
var
  MyTextWord:TMyTextWord;
begin  
  MyTextWord:=Data[Index];
  write(MyTextWord.Text);
  if MyTextWord.NeedLinebreak then writeln;
end;

Здесь мы заменили блок case, который мог выглядеть вот так

procedure case_test(Index:Integer);
begin
  case Index of
    0: write('Hello');
    1: write(' ');
    2: 
    begin
      write('Habr!'); 
      writeln;   
    end;
  end;
end;

Таким образом мы сводим количество действий для выполнения любого из случаев в блоке case до минимума, одинакового для всех случаев. Хотя здесь не сильно видна разница т.к. один набор из 3-ех действий заменился другим. Но подумайте, что выполнится быстрее: «50 раз проверить, является ли переменная одним из чисел?» или «Получить по индексу из массива 1 параметр из 50 возможных?». Ответ очевиден.

И так мы пришли к тому что case не далеко ушёл от известного нам if.
А раз мы научились оптимизировать case почему бы не пойти дальше?

Чем заменить if

Допустим у нас case не использует настроек, которые можно было бы записать в обычный массив. Например такой case:

class procedure ActiveRecord<T>.SetFields(Fields: TArray<TField>;
  Data: Pointer);
var
  I:Integer;
  PRec:Pointer;
begin
  PRec:=@Data;
  for I:=0 to Length(Fields)-1 do
  begin
    case Fields[I].Kind of
      tkUString,
      tkWideString:  PString(PRec)^:=PString(Fields[I].Data)^;
      tkInteger:     PInteger(PRec)^:=PInteger(Fields[I].Data)^;
      tkInt64:       PInt64(PRec)^:=PInt64(Fields[I].Data)^;
      tkFloat:       PDouble(PRec)^:=PDouble(Fields[I].Data)^;
      tkEnumeration: PWord(PRec)^:=PWord(Fields[I].Data)^;
    end;
    IncPtr(PRec,Fields[I].Size);
  end;
end;

Но перед главным решением я сделаю отступление, чтобы описать ход своих мыслей.

Допустим у нас есть некая процедура содержащая несколько блоков кода.

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

Мы знаем заведомо простое решение этой проблемы: перечислить в массиве процедуры, вот так

procedure SetString(A,B:Pointer); inline;
procedure SetInt(A,B:Pointer); inline;
procedure SetInt64(A,B:Pointer); inline;
procedure SetDouble(A,B:Pointer); inline;
procedure SetBool(A,B:Pointer); inline;

implementation

procedure SetString(A,B:Pointer); begin PString(A)^:=PString(B)^; end;
procedure SetInt(A,B:Pointer); begin PInteger(A)^:=PInteger(B)^; end;
procedure SetInt64(A,B:Pointer); begin PInt64(A)^:=PInt64(B)^; end;
procedure SetDouble(A,B:Pointer); begin PDouble(A)^:=PDouble(B)^; end;
procedure SetBool(A,B:Pointer); begin PBoolean(A)^:=PBoolean(B)^; end;

type
  TTypeHandlerProc = reference to procedure (A,B:Pointer);

var
  TypeHandlers:Array[TTypeKind] of TTypeHandlerProc;

class procedure ActiveRecord<T>.SetFields(Fields: TArray<TField>;
  Data: Pointer);
var
  I:Integer;
  PRec:Pointer;
begin
  PRec:=@Data;
  for I:=0 to Length(Fields)-1 do
  begin
    TypeHandlers[Fields[I].Kind](PRec, Fields[I].Data);
    IncPtr(PRec,Fields[I].Size);
  end;
end;

initialization
  TypeHandlers[tkUString]:=SetString;
  TypeHandlers[tkWideString]:=SetString;
  TypeHandlers[tkInteger]:=SetInt;
  TypeHandlers[tkInt64]:=SetInt64;
  TypeHandlers[tkFloat]:=SetDouble;
  TypeHandlers[tkEnumeration]:=SetBool;
end.

Здесь мы создали массив с inline процедурами, т.е. вместо вызова этих процедур компилятор подставит их код в строку, из которой мы к ним обращаемся. А в остальном всё как раньше, обращаемся к массиву по индексу операции, и выполняем операцию указывая в круглых скобках параметры. Обработчик представлен в сокращенном варианте, т.к. обработка всех действий с типом TTypeKind выглядит громоздкой.

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

Если вы уверенный в себе программист и хотите максимальной оптимизации, но не хотите засорять модуль кучей примочек. Я представляю вам решение прямиком из тёмной стороны кодинга. Все кодеры вокруг говорят, что использовать goto не безопасно, что сам оператор устарел и в 90% случаях существуют решения без goto. Говорят что использование ассемблерных вставок доступно только злым хакерам. Но что будет, если мы пустимся во все тяжкие?

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

К сожалению в generic методах и классах нельзя использовать ассемблерные вставки, по этому решение пришлось переместить в метод другого объекта, хотя на самом решении это не отразилось. Решение представлено для x32 мода.

procedure TTestClass.Test(Fields: TArray<TField>; Data: Pointer);
label
  LS,LI,LI64,LF,LE,FIN;
var
  I:Integer;
  PRec:Pointer;
  ADR:Cardinal;
  Types:Array[TTypeKind] of Cardinal;
begin
  FillChar(Types,Length(Types)*4,#0);
  asm
    lea EDX, [EAX].Types
    mov [EAX-$4C+tkUString*4], offset LS
    mov [EAX-$4C+tkWideString*4], offset LS
    mov [EAX-$4C+tkInteger*4], offset LI
    mov [EAX-$4C+tkInt64*4], offset LI64
    mov [EAX-$4C+tkFloat*4], offset LF
    mov [EAX-$4C+tkEnumeration*4], offset LE
  end;

  PRec:=Data;
  for I:=0 to Length(Fields)-1 do
  begin
    ADR:=Types[Fields[I].Kind];
    asm jmp ADR end;
    LS:   PString(PRec)^:=PString(Fields[I].Data)^;   goto FIN;
    LI:   PInteger(PRec)^:=PInteger(Fields[I].Data)^; goto FIN;
    LI64: PInt64(PRec)^:=PInt64(Fields[I].Data)^;     goto FIN;
    LF:   PDouble(PRec)^:=PDouble(Fields[I].Data)^;   goto FIN;
    LE:   PByte(PRec)^:=PByte(Fields[I].Data)^;       goto FIN;
    FIN:  

    IncPtr(PRec,Fields[I].Size);
  end;
end;

Трюк этого способа заключается в том, что компилятор delphi сам хранит адреса всех label и в ассемблерных вставках дает к ним доступ. Решение нашлось неожиданно просто[1]. Когда я искал как считать регистр EIP, в котором хранится адрес текущей исполняемой команды. Оказалось, что регистр считать нельзя, а вот адрес label'а как раз можно.

Ну а дальше всё просто, на ассемблере заполняем массив адресами нужных нам label'ов.
В цикле по массиву, берется каждый элемент. Тип элемента = индекс адреса его обработчика. Берем по индексу адрес обработчика, прыгаем на адрес, профит.

    ADR:=Types[Fields[I].Kind];
    asm jmp ADR end;

Остались чисто формальности: после каждого блока ставим прыжок вконец цикла «goto FIN;», чтобы не попадать на следующие label блоки.

Константа $4C — это количество байт до начала блока с памятью массива, чтобы её вычислить можете записать в массив заполненный нулями «mov [EAX], 1» и посмотреть в дебагере какая ячейка приняла это значение, количество ячеек от начала до неё * 4 и будет ваша константа.

Пишите своё мнение, и правки к статье в комментариях. Желаю успехов с оптимизацией кода.

References:

1. Хак с адресом EIP через label