Бесконечные генераторы значений на Delphi + Ассемблер

В функциональных языках программирования есть возможность генерировать бесконечные последовательности значений (как правило чисел) и оперировать этими последовательностями. Реализуется это функцией, которая, не прерывая свою работу, генерирует значения одно за другим на основе своего внутреннего состояния.
Но, к сожалению, в обычных языках нет возможности «вернуть» значения в место вызова не выходя из функции. Один вызов — один результат.
Генераторы удобно было бы использовать совместно с возможностью Delphi по перечислению значений (GetEnumerator/MoveNext/GetCurrent). В этой статье мы создадим функцию-генератор (может даже бесконечную) и будем использовать ее с таким объектом для перечисления, чтобы всё работало прозрачно без необходимости вникать в реализацию.

Причина невозможности вернуть значение без полного выхода из функции в том, что вызываемая функция использует тот же стек, что вызывающая. То есть, если вызванная функция сгенерирует очередное значение, то нужно найти способ вернуть управление программе для обработки. Главное, чтобы локальные данные вызванной функции не повреждались, и, когда потребуется, мы могли запустить ее с того же места, на котором прервали. Начнем с того, что для функции нужен отдельный стек. Ни Windows, ни процессор не могут запретить нам создать несколько стеков и время от времени переключаться между ними. Единственное, что мы потеряем, так это исключение Stack Overflow (конечно только если функция реально выйдет за пределы стека). Вместо него будет сгенерирован стандартный Access Violation.

Подходящую для генератора функцию можете написать сами или возьмем что-нибудь знакомое и понятное, например генератор чисел Фибоначчи.
Алгоритм, описанный в статье, не ограничивает нас в выборе функции, она может возвращать (генерировать) значения любых типов, а самое главное быть «бесконечной». «Бесконечная» функция генерирует значения, пока перечисление не прервано инструкцией break в теле цикла for-in. Так, например, можно искать файлы на диске, просматривая каждый и прерывая поиск, когда найден нужный. Преимущества этого способа, по сравнению с написанием собственного энумератора, в том, что функция может использовать локальные переменные (например TSearchRec совместно с функциями FindFirst/FindNext/FindClose). А по сравнению с сохранением всех значений во временный массив, генераторы потребляют меньше памяти, а в случае в поиском чего-либо, время в среднем сокращается вдвое (не тратится на формирование оставшейся части массива после найденного элемента).
Представьте, что у нас есть такая функция:

procedure Fibonacci( Generator: TGeneratorWithParam<UInt64, UInt64> );
var
  V1, V2, V: UInt64;
begin
  V1 := 1;
  V2 := 1;
  V := V1 + V2;
  while Generator.Yield( V ) and ( V >= V2 ) do
  begin
    V1 := V2;
    V2 := V;
    V := V1 + V2;
  end;
end;

Функция генерирует числа и «отдает» их энумератору вызовом Generator.Yield.
Когда значения выходят за разрядную сетку (второе условие после «and»), функция завершает свою работу.
Заметьте, что если Generator.Yield вернет False, то функция тоже завершится. Это произойдет, если энумератор был уничтожен до того, как функция перечислила все числа до 2^64, то есть цикл for-in был прерван инструкцией break, exit или прерван исключением.

Код для вывода чисел будет такой:

  for X in TGenerator<UInt64>.Create( Fibonacci ) do
  begin
    WriteLn( X );
  end;

Теперь нужно написать такой класс TGeneratorWithParam<T1,T2>, чтобы приведенная выше функция и код, ее использующий, могли работать вместе.

Код будет использовать поздние возможности Delphi (XE2, XE3) и будет компилироваться одинакого успешно как 32-разрядным, так и 64-разрадным компилятором (полный код в конце статьи под спойлером).

Чтобы функция могла «возвращать» значения разных типов, сделаем класс TGenerator параметризованным.
Тогда нужно выделить данные, не зависящие от возвращаемого типа в отдельный класс, чтобы к этому классу был доступ из ассемблерного кода.

  TGeneratorContext = record
    SP: NativeUInt; // Указатель стека. 
      // Пока выполняется функция-генератор в это поле 
      // сохраняется указатель стека основной программы, 
      // пока выполняется программа - в поле лежит указатель 
      // стека функции.
    Stack: PNativeUIntArray; // Указатель на стек.
      // Будет выделяться с помощью VirtualAlloc
    StackLen: NativeUInt; // Длина стека
    Generator: TObject; // Ссылка на объект Генератор
    Active: Boolean; // Активна ли функция
  end;

  TGeneratorBase = class
  protected
    Context: TGeneratorContext; // Контекст (в т.ч. стек функции)
    FFinished: Boolean;  // Завершено ли перечисление
  end;

  TGeneratorWithParam<ParamT, ResultT> = class( TGeneratorBase )
  protected
    FFunc: TGeneratorFunction<ParamT, ResultT>;
    FValue: ResultT;
    FParam: ParamT;
  public
    procedure Stop;
    function Yield( const Value: ResultT ): Boolean;
  public
    function GetCurrent: ResultT;
    function MoveNext: Boolean;
    property Current: ResultT read GetCurrent;
    function GetEnumerator: TGeneratorWithParam<ParamT, ResultT>;
    constructor Create( Func: TGeneratorFunction<ParamT, ResultT>; const Param: ParamT ); overload;
    constructor Create( Func: TGeneratorFunction<ParamT, ResultT> ); overload;
    destructor Destroy; override;
    property Param: ParamT read FParam;
    property Value: ResultT read FValue;
  end;

  TGenerator<T> = class( TGeneratorWithParam<T, T> );

    // Теоретически логичнее было бы использовать такое объявление:
  //TGenerator<T> = TGeneratorWithParam<T, T>;
    // Но компилятор Delphi не принимает его

Также нужно предусмотреть возможность завершить перечисление как со стороны программы (выход из цикла for-in), так и со стороны функции (выход из функции).
Как только основная программа завершает цикл for-in, уничтожается объект TGenerator, в деструкторе которого происходит завершение функции:
1. Снова переключается контекст на выполнение функции.
2. Метод Yield на стороне функции-генератора возвращает False
3. Функция-генератор выходит из цикла и штатно завершает свою работу. Она может также правильно финализировать свои переменные, освободить ресурсы, и т. д.

Проделаем с классом TGenerator один интересный трюк. Объявим метод GetEnumerator, а также методы MoveNext и GetCurrent (не забудем и про свойство Current).
Метод GetEnumerator будет выглядеть так:

function TGeneratorWithParam<ParamT, ResultT>.GetEnumerator: TGeneratorWithParam<ParamT, ResultT>;
begin
  Result := Self;
end;

Что здесь происходит? Функция возвращает в качестве объекта-энумератора сам объект-генератор.
Сделано это для упрощения использования класса, а также исходя из такой особенности: если функция завершила свое выполнение после выхода из цикла for-in, то нет легкого способа снова запустить ее для следующего цикла. Поэтому многократное использование энумератора решено отменить. То есть:
1. Создали генератор
2. Получили энумератор (он же генератор)
3. Перечислили все значения
4. Уничтожили энумератор (он же генератор)

Если нужно заново запустить функцию и перечислить все значения, то тогда генератор создается еще раз.
Заметим, что если некий объект (или даже запись) в методе GetEnumerator возвращают объект, то он освобождается автоматически после выхода из цикла. То же относится и к интерфейсам и записям, но они удаляются корректо и в других случаях, а то, что это правило касается и объектов, немного нетипично для Delphi, в которой пока нет автоматического удаления созданных объектов (действительно пока, потому что сейчас идет работа над полноценной сборкой мусора, это видно в исходниках system.pas из XE3).

При создании генератора нужно выполнить следующие действия:

1. Выделить память под стек.

  Context.Stack := VirtualAlloc( nil, MinStackSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE );
  Context.StackLen := MinStackSize div SizeOf( NativeUInt );

2. Установить указатель SP.

  Context.SP := NativeUInt( @Context.Stack^[Context.StackLen - 8 {$IFDEF CPUX64} - 6 {$ENDIF}] );

2. Записать в стек начальные значения.

  Context.Stack^[Context.StackLen - 4] := GetFlags; 
    // Записать регистр флагов (EFLAGS/RFLAGS)
  Pointer( Context.Stack^[Context.StackLen - 3] ) := @Func; 
    // Указатель на функцию (EIP/RIP)
  Pointer( Context.Stack^[Context.StackLen - 2] ) := @TGeneratorContext.Return; 
    // На этот адрес перейдет выполнение, когда завершится функция-генератор
  Pointer( Context.Stack^[Context.StackLen - 1] ) := Self; 
    // Self для функции TGeneratorContext.Return

Также для отладочных целей сразу после создания стека можно вписать такую строку:

  FillChar( Context.Stack^, Context.StackLen * SizeOf( NativeUInt ), $DD );

В деструкторе нужно остановить функцию и освободить память, отведенную для стека.

  if not FFinished then
    Stop;
  VirtualFree( Context.Stack, 0, MEM_RELEASE );

Метод MoveNext будет вызывать функцию-генератор, получать от нее значение и проверять, продолжать ли перечисление (то есть не завершилась ли функция). Метод не слишком сложный, особенно, если учесть, сколько всего он делает.

function TGeneratorWithParam<ParamT, ResultT>.MoveNext: Boolean;
begin
  if not Context.Active then // Если функция еще не запущена...
  begin
    Context.Active := True;
    Context.Enter( NativeUInt( Self ) ); 
      // Переключить контекст: стек программы -> стек функции
      // Как аргумент процедуре Enter здесь передается указатель 
      // на сам генератор (Self), он помещается EAX (и RCX для x64)       
      // перед запуском функции. Функция видит это значение
      // в качестве своего первого аргумента.
  end
  else
  begin
    Context.Enter( Ord( True ) );
      // В случае, если функция уже выполняется, то передать 
      // ей в EAX значение True. Функция сочтет это результатом 
      // выполнения метода Yield и продолжит генерировать 
      // для нас новые значения.
  end;
  Result := not FFinished; 
    // К данному моменту следующее значение записано в поле FValue, 
    // так что нужно только вернуть True, если это значение 
    // сгенерировано, или False, если функция-генератор 
    // завершила работу (значит новых значений нет).
end;

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

function TGeneratorWithParam<ParamT, ResultT>.Yield( const Value: ResultT ): Boolean;
begin
  FValue := Value; // Сохранить сгенерированное значение из функции
  Context.Leave; // Переключить контекст: стек функции -> стек программы
  Result := not FFinished; 
    // Эта строка здесь не обязательна, потому что значение, 
    // которое возвращает Yield, формируется в другом месте 
    // и в другое время (когда происходит возврат в функцию), 
    // но пусть остается здесь для наглядности и чтобы 
    // Delphi не генерировала напрасно соответствующее 
    // предупреждение.
end;

Основная задача этой функции вовсе не вернуть результат в функцию-генератор, а сохранить сгенерированное значение и вернуться в основной контекст, чтобы это значение могло быть обработано внутри цикла for-in, например выведено на экран. На самом деле после того, как стек заменен в процедуре Context.Leave, управление будет сразу передано на строку, следующую после вызова процедуры Context.Enter (в методе MoveNext).

Метод Stop выполняется в одном случае: если к моменту, когда вызывается деструктор, функция еще не завершила генерацию значений. Поскольку функции надо финализировать переменные, освободить ресурсы и вообще нормально завершить работу, то нужно еще раз передать управление ей, сделав так, чтобы вызов метода Yield вернул False.

procedure TGeneratorWithParam<ParamT, ResultT>.Stop;
begin
  FFinished := True;
  if Context.Active then // Если функция еще не завершилась ...
    Context.Enter( Ord( False ) ); 
      // Переключить контекст: стек программы -> стек функции
      // Здесь в качестве регистра EAX передается False, 
      // что функция воспримет как значение, возвращенное из метода Yield.
end;

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

procedure SwitchContext;
asm
// Перед вызовом SwitchContext в регистр ECX должен быть 
// записан адрес структуры контекста TGeneratorContext
  pushfd               // Сохраним EFLAGS
  push EBX             // Регистры общего назначения
  push EBP             // Регистры EAX,ECX,EDX сохранять 
                       // не нужно, поскольку их не запрещено 
                       // изменять 
  push ESI             // во время вызова любых процедур.
  push EDI             //
// Момент когда меняется стек:
// Меняем указатель стека и поле SP между собой
  xchg ESP, dword ptr [ECX].TGeneratorContext.&SP
// Загружаем регистры из нового стека
  pop EDI
  pop ESI
  pop EBP
  pop EBX
  popfd               // Восстанавливаем EFLAGS
 // ret 
end;

Регистр EIP сохранять не нужно, потому что после выполнения инструкции ret (а она неявно присутствует в любой ассемблерной процедуре Delphi) процессор возвратится по адресу, который сохранен в стеке во время вызова процедур Enter и Leave.

Так будет выглядеть процедура Enter:

procedure TGeneratorContext.Enter( Input: NativeUInt );
asm
  mov ECX, EAX       // Self, Указатель на TGeneratorContext
  mov EAX, EDX       // Input, значение EAX в момент переключения контекста
  jmp SwitchContext  // Выполнить переключение
end;

А так Leave:

procedure TGeneratorContext.Leave;
asm
  mov ECX, EAX       // Self, Указатель на TGeneratorContext
  jmp SwitchContext
end;

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

procedure TGeneratorContext.Return;
asm
  pop ECX                                // Взять из стека Self, указатель на TGeneratorContext
  mov [ECX].TGeneratorBase.FFinished, 1  // Установить Finished := True
  lea ECX, [ECX].TGeneratorBase.Context  // Получить смещение на Context.
  jmp SwitchContext                      // Вернуться в контекст программы
end;

Осталась только небольшая служебная функция, получающая значение регистра флагов:

function GetFlags: NativeInt;
asm
  pushfd
  pop EAX
end;

Тестировать модуль лучше в консольном приложении. Если использовать модуль в оконном приложение, то нужно удалить вывод на экран с помощью WriteLn.

unit DCa.Generators;

interface

uses
  Winapi.Windows;

const
  MinStackSize = 8 * 16384;

type
  TNativeUIntArray = array [0 .. 65535] of NativeUInt;
  PNativeUIntArray = ^TNativeUIntArray;

  TGeneratorWithParam<ParamT, ResultT> = class;

  TGeneratorFunction<ParamT, ResultT> = procedure( Generator: TGeneratorWithParam<ParamT, ResultT> );

  PGeneratorContext = ^TGeneratorContext;

  TGeneratorContext = packed record
  public
    SP: NativeUInt;
    Stack: PNativeUIntArray;
    StackLen: NativeUInt;
    Generator: TObject;
    Active: Boolean;
    procedure Enter( Input: NativeUInt = 0 );
    procedure Leave;
    procedure Return;
  end;

  TGeneratorBase = class
  protected
    Context: TGeneratorContext;
    FFinished: Boolean;
  end;

  TGeneratorWithParam<ParamT, ResultT> = class( TGeneratorBase )
  protected
    FFunc: TGeneratorFunction<ParamT, ResultT>;
    FValue: ResultT;
    FParam: ParamT;
  public
    procedure Stop;
    function Yield( const Value: ResultT ): Boolean;
  public
    function GetCurrent: ResultT;
    function MoveNext: Boolean;
    property Current: ResultT read GetCurrent;
    function GetEnumerator: TGeneratorWithParam<ParamT, ResultT>;
    constructor Create( Func: TGeneratorFunction<ParamT, ResultT>; const Param: ParamT ); overload;
    constructor Create( Func: TGeneratorFunction<ParamT, ResultT> ); overload;
    destructor Destroy; override;
    property Param: ParamT read FParam;
    property Value: ResultT read FValue;
  end;

  TGenerator<T> = class( TGeneratorWithParam<T, T> );

procedure Fibonacci( Generator: TGeneratorWithParam<UInt64, UInt64> );

function GetFlags: NativeInt;

implementation

procedure Fibonacci( Generator: TGeneratorWithParam<UInt64, UInt64> );
var
  V1, V2, V: UInt64;
begin
  WriteLn( 'Fib Enter' );
  V1 := 1;
  V2 := 1;
  V := V1 + V2;
  while Generator.Yield( V ) and ( V >= V2 ) do
  begin
    V1 := V2;
    V2 := V;
    V := V1 + V2;
  end;
  WriteLn( 'Fib Exit' );
end;

function GetFlags: NativeInt;
asm
  {$IFDEF CPUX86}
  pushfd
  pop EAX
  {$ELSE}
  pushfq
  pop RAX
  {$ENDIF}
end;

constructor TGeneratorWithParam<ParamT, ResultT>.Create( Func: TGeneratorFunction<ParamT, ResultT>;
  const Param: ParamT );
begin
  FFunc := Func;
  FParam := Param;
  Context.Generator := Self;

  Context.Stack := VirtualAlloc( nil, MinStackSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE );
  Context.StackLen := MinStackSize div SizeOf( NativeUInt );
{$IFDEF DEBUG}
  FillChar( Context.Stack^, Context.StackLen * SizeOf( NativeUInt ), $DD );
{$ENDIF}
  Context.SP := NativeUInt( @Context.Stack^[Context.StackLen - 8 {$IFDEF CPUX64} - 6 {$ENDIF}] );

  Context.Stack^[Context.StackLen - 4] := GetFlags;
  Pointer( Context.Stack^[Context.StackLen - 3] ) := @Func;
  Pointer( Context.Stack^[Context.StackLen - 2] ) := @TGeneratorContext.Return;
  Pointer( Context.Stack^[Context.StackLen - 1] ) := Self;
end;

constructor TGeneratorWithParam<ParamT, ResultT>.Create( Func: TGeneratorFunction<ParamT, ResultT> );
begin
  Create( Func, Default ( ParamT ) );
end;

destructor TGeneratorWithParam<ParamT, ResultT>.Destroy;
begin
  if not FFinished then
    Stop;
  inherited;
  VirtualFree( Context.Stack, 0, MEM_RELEASE );
end;

function TGeneratorWithParam<ParamT, ResultT>.GetCurrent: ResultT;
begin
  Result := Value;
end;

function TGeneratorWithParam<ParamT, ResultT>.GetEnumerator: TGeneratorWithParam<ParamT, ResultT>;
begin
  Result := Self;
end;

function TGeneratorWithParam<ParamT, ResultT>.MoveNext: Boolean;
begin
  if not Context.Active then
  begin
    Context.Active := True;
    Context.Enter( NativeUInt( Self ) );
  end
  else
  begin
    Context.Enter( Ord( True ) );
  end;
  Result := not FFinished;
end;

procedure TGeneratorWithParam<ParamT, ResultT>.Stop;
begin
  FFinished := True;
  if Context.Active then
    Context.Enter( Ord( False ) );
end;

function TGeneratorWithParam<ParamT, ResultT>.Yield( const Value: ResultT ): Boolean;
begin
  FValue := Value;
  Context.Leave;
  Result := not FFinished;
end;

{ TGeneratorContext }

procedure SwitchContext;
asm
  {$IFDEF CPUX86}
  pushfd               //EFLAGS
  push EBX
  push EBP
  push ESI
  push EDI
  //
  xchg ESP, dword ptr [ECX].TGeneratorContext.&SP
  //
  pop EDI
  pop ESI
  pop EBP
  pop EBX
  popfd               //EFLAGS
  {$ELSE}
  pushfq               //EFLAGS
  push RBX
  push RBP
  push RSI
  push RDI
  push R10
  push R11
  push R12
  push R13
  push R14
  push R15
  //
  xchg RSP, qword ptr [RDX].TGeneratorContext.&SP
  //
  pop R15
  pop R14
  pop R13
  pop R12
  pop R11
  pop R10
  pop RDI
  pop RSI
  pop RBP
  pop RBX
  popfq               //EFLAGS
  {$ENDIF}
end;

procedure TGeneratorContext.Enter( Input: NativeUInt );
asm
  {$IFDEF CPUX86}
  mov ECX, EAX
  mov EAX, EDX
  jmp SwitchContext
  {$ELSE}
  mov RAX, RDX
  mov RDX, RCX
  mov RCX, RAX
  jmp SwitchContext
  {$ENDIF}
end;

procedure TGeneratorContext.Leave;
asm
  {$IFDEF CPUX86}
  mov ECX, EAX
  jmp SwitchContext
  {$ELSE}
  mov RDX, RCX
  jmp SwitchContext
  {$ENDIF}
end;

procedure TGeneratorContext.Return;
asm
  {$IFDEF CPUX86}
  pop ECX
  mov [ECX].TGeneratorBase.FFinished, 1
  lea ECX, [ECX].TGeneratorBase.Context
  jmp SwitchContext
  {$ELSE}
  pop RDX
  mov [RDX].TGeneratorBase.FFinished, 1
  lea RDX, [RDX].TGeneratorBase.Context
  jmp SwitchContext
  {$ENDIF}
end;

initialization

finalization

end.

Автор: DCa

Источник