Delphi + Assemblerの無限値ジェネレーター

関数型プログラミング言語では、値の無限シーケンス(通常は数値)を生成し、これらのシーケンスを操作できます。 これは、作業を中断することなく、内部状態に基づいて値を1つずつ生成する関数によって実現されます。

ただし、残念なことに、通常の言語では、関数を終了せずに呼び出しの場所に値を「戻す」方法はありません。 1つの課題-1つの結果。

Delphiの値を列挙する機能(GetEnumerator / MoveNext / GetCurrent)と一緒にジェネレータを使用すると便利です。 この記事では、ジェネレーター関数(無限の場合もあります)を作成し、そのようなオブジェクトで列挙に使用して、実装を詳しく調べることなくすべてが透過的に機能するようにします。



関数を完全に終了せずに値を返すことができない理由は、呼び出された関数が呼び出し元と同じスタックを使用するためです。 つまり、呼び出された関数が次の値を生成する場合、処理のために制御をプログラムに戻す方法を見つける必要があります。 主なことは、呼び出された関数のローカルデータが破損してはならず、必要に応じて、中断した場所から開始できることです。 まず、関数には別のスタックが必要です。 Windowsもプロセッサも、複数のスタックを作成したり、スタックを時々切り替えたりすることを防ぐことはできません。 私たちが失う唯一のものは、Stack Overflow例外です(もちろん、関数が本当にスタックを超える場合のみ)。 代わりに、標準のアクセス違反が生成されます。



ジェネレータに適した関数を自分で作成するか、フィボナッチ数ジェネレータなどの使い慣れたわかりやすいものを使用できます。

この記事で説明するアルゴリズムは、関数の選択を制限するものではなく、任意のタイプの値を返す(生成する)ことができ、最も重要なことは「無限」であることです。 「無限」関数は、for-inループの本体のbreakステートメントによって列挙が中断されるまで値を生成します。 そのため、たとえば、ディスク上のファイルを検索し、それぞれを見て、正しいファイルが見つかったら検索を中断できます。 独自の列挙子を作成する場合と比べて、このメソッドの利点は、関数がローカル変数を使用できることです(たとえば、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」の後の2番目の条件)を超えると、関数は処理を終了します。

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クラスで興味深いトリックを1つ実行してみましょう。 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の場合に少し異例です。フルガベージコレクションでは、これはXE3のソースsystem.pasで確認できます。



ジェネレータを作成するときは、次の手順を実行する必要があります。



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;
      
      







次の方法は非常に単純に見えます。 3行のみで、そのうちの1行も実行されません。 これは、次の値が生成されるときに関数から呼び出される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メソッドは、1つのケースで実行されます。デストラクタが呼び出されるまでに、関数が値の生成を完了していない場合。 関数は変数を確定し、リソースを解放し、通常は正常に動作を終了する必要があるため、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;
      
      







そしてそのままにしておきます:



 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を使用して画面への出力を削除する必要があります。



完全なモジュールコード(X86 / X64アセンブラーを含む)
 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.
      
      








All Articles