📜 ⬆️ ⬇️

Infinite value generators on Delphi + Assembler

In functional programming languages, it is possible to generate infinite sequences of values ​​(as a rule of numbers) and operate on these sequences. It is implemented by a function that, without interrupting its work, generates values ​​one after another based on its internal state.
But, unfortunately, in ordinary languages ​​it is not possible to “return” values ​​to the place of a call without leaving the function. One challenge - one result.
Generators would be conveniently used in conjunction with Delphi's ability to enumerate values ​​(GetEnumerator / MoveNext / GetCurrent). In this article, we will create a generator function (maybe even infinite) and use it with such an object for enumeration so that everything works transparently without needing to delve into the implementation.

The reason why it is impossible to return a value without completely exiting the function is that the called function uses the same stack as the calling one. That is, if the called function generates the next value, then you need to find a way to return control to the program for processing. The main thing is that the local data of the called function is not damaged, and, when necessary, we can start it from the same place where we interrupted. Let's start with the fact that the function needs a separate stack. Neither Windows nor the processor can prevent us from creating several stacks and switching between them from time to time. The only thing that we will lose is a Stack Overflow exception (of course, only if the function really goes beyond the stack). Instead, a standard Access Violation will be generated.

You can write a suitable function for the generator yourself or take something familiar and understandable, for example, the Fibonacci number generator.
The algorithm described in the article does not limit us in choosing a function; it can return (generate) values ​​of any type, and most importantly be “infinite”. The “infinite” function generates values ​​until the enumeration is interrupted by the break statement in the body of the for-in loop. For example, you can search for files on the disk, browsing each one and interrupting the search when the right one is found. The advantages of this method, compared to writing your own enumerator, are that the function can use local variables (for example, TSearchRec together with the FindFirst / FindNext / FindClose functions). And compared to storing all the values ​​in a temporary array, the generators consume less memory, and in the case of searching for something, the time is reduced by an average of half (not spent on the formation of the remaining part of the array after the element found).
Imagine that we have such a function:

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; 

')
The function generates numbers and "gives" them to the enumerator by calling Generator.Yield.
When values ​​go beyond the bit grid (the second condition after “and”), the function ends its work.
Note that if Generator.Yield returns False, the function will also terminate. This will happen if the enumerator was destroyed before the function listed all the numbers up to 2 ^ 64, that is, the for-in loop was interrupted by a break, exit statement, or interrupted by an exception.

The code for outputting numbers will be:

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


Now you need to write such a class TGeneratorWithParam <T1, T2> so that the above function and the code that uses it can work together.

The code will use the latest Delphi features (XE2, XE3) and will compile the same successfully with both the 32-bit and 64-bit compilers (the full code at the end of the article under the spoiler).

In order for the function to “return” values ​​of different types, we will make the TGenerator class parameterized.
Then you need to select data that does not depend on the return type in a separate class, so that this class can be accessed from the assembly code.

  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    


It is also necessary to provide the possibility to complete the enumeration both from the program side (exit from the for-in loop) and from the side of the function (exit from the function).
As soon as the main program completes the for-in loop, the TGenerator object is destroyed, in the destructor of which the function is terminated:
1. Again the context switches to the execution of the function.
2. Method Yield on the side of the function generator returns False
3. The generator function exits the loop and ends its work regularly. It can also correctly finalize its variables, free up resources, etc.

Let's do one interesting trick with the TGenerator class. Let's declare the GetEnumerator method, as well as the MoveNext and GetCurrent methods (let's not forget about the Current property).
The GetEnumerator method will look like this:

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


What's going on here? The function returns the generator object itself as an enumerator object.
This is done to simplify the use of the class, as well as based on this feature: if the function has completed its execution after exiting the for-in loop, then there is no easy way to start it again for the next loop. Therefore, it is decided to cancel the repeated use of the enumerator. I.e:
1. Created a generator
2. Received enumerator (aka generator)
3. Listed all the values.
4. Destroyed enumerator (aka generator)

If you need to restart the function and list all the values, then the generator is created again.
Note that if a certain object (or even a record) in the GetEnumerator method returns an object, it is released automatically after exiting the loop. The same applies to interfaces and records, but they are deleted correctly and in other cases, and the fact that this rule applies to objects is a bit atypical for Delphi, in which there is no automatic deletion of the created objects (really so far, because work is underway above the full garbage collection, it can be seen in the source code of system.pas from XE3).

When creating a generator, you must perform the following steps:

1. To allocate memory for the stack.

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


2. Set the SP pointer.

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


2. Write the initial values ​​to the stack.

  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 


Also for debugging purposes, immediately after creating the stack, you can enter the following line:

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


In the destructor, you need to stop the function and free up the memory allocated for the stack.

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


The MoveNext method will call the generator function, get a value from it and check whether the transfer should continue (that is, if the function has not completed). The method is not too complicated, especially if you consider how much it does.

 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; 


The following method looks quite simple. Only three lines, one of which is never even executed. This is the Yield method, which is called from the function when the next value is generated.

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


The main task of this function is not to return the result to the generator function at all, but to save the generated value and return to the main context so that this value can be processed inside the for-in loop, for example, displayed on the screen. In fact, after the stack is replaced in the Context.Leave procedure, control will be immediately transferred to the line following the procedure called Context.Enter (in the MoveNext method).

The Stop method is executed in one case: if by the time the destructor is called, the function has not yet completed the generation of values. Since the functions need to finalize the variables, free up resources and generally complete the work, then you need to transfer control to it again, making the call to Yield method return False.

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


To switch the stack, we will have a separate procedure. It will be used to switch to both sides.
Its task is to save the state to the current stack and load the new state from the new stack.

 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; 


You do not need to save the EIP register, because after executing the ret instruction (and it is implicitly present in any Delphi assembly procedure), the processor will return to the address that was stored on the stack during the call to Enter and Leave procedures.

This is what the Enter procedure will look like:

 procedure TGeneratorContext.Enter( Input: NativeUInt ); asm mov ECX, EAX // Self,   TGeneratorContext mov EAX, EDX // Input,  EAX     jmp SwitchContext //   end; 


And so Leave:

 procedure TGeneratorContext.Leave; asm mov ECX, EAX // Self,   TGeneratorContext jmp SwitchContext end; 


After the generator function is completed, the execution will be passed to this procedure, since its address is in the stack below everything, forcing the function, upon reaching the ret instruction, return back here to complete the generation.

 procedure TGeneratorContext.Return; asm pop ECX //    Self,   TGeneratorContext mov [ECX].TGeneratorBase.FFinished, 1 //  Finished := True lea ECX, [ECX].TGeneratorBase.Context //    Context. jmp SwitchContext //     end; 


Only a small utility function remains, which receives the value of the flag register:

 function GetFlags: NativeInt; asm pushfd pop EAX end; 


Test the module better in the console application. If you use the module in a windowed application, then you need to remove the output to the screen using WriteLn.

Full module code (including X86 / X64 assembler)
 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