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;
for X in TGenerator<UInt64>.Create( Fibonacci ) do begin WriteLn( X ); end;
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
function TGeneratorWithParam<ParamT, ResultT>.GetEnumerator: TGeneratorWithParam<ParamT, ResultT>; begin Result := Self; end;
Context.Stack := VirtualAlloc( nil, MinStackSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE ); Context.StackLen := MinStackSize div SizeOf( NativeUInt );
Context.SP := NativeUInt( @Context.Stack^[Context.StackLen - 8 {$IFDEF CPUX64} - 6 {$ENDIF}] );
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 );
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;
function TGeneratorWithParam<ParamT, ResultT>.Yield( const Value: ResultT ): Boolean; begin FValue := Value; // Context.Leave; // : -> Result := not FFinished; // , , // Yield, // ( ), // // Delphi // . end;
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;
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;
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;
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.
Source: https://habr.com/ru/post/157777/
All Articles