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

Подходящую для генератора функцию можете написать сами или возьмем что-нибудь знакомое и понятное, например генератор чисел Фибоначчи.
Алгоритм, описанный в статье, не ограничивает нас в выборе функции, она может возвращать (генерировать) значения любых типов, а самое главное быть «бесконечной». «Бесконечная» функция генерирует значения, пока перечисление не прервано инструкцией 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.