1

I'm using a Delphi generator implementation.

The main idea is taken from here: https://habr.com/ru/articles/157777 (text in Russian, but the main idea is clear from the code). The same code can be used to implement non-preemptive multitasking in Delphi. The basic idea is that each running task has its own stack, and there is some mechanism to switch the task's stack to the main program's stack and vice versa.

I slightly modified the code from the link above so that the procedure being executed is a class method, and also so that the task can throw and handle exceptions. Everything, in general, works, but there is an effect that I do not understand: when the application creates its first task, and the first exception is generated within it, then a significant amount of time passes between the moment of generation and the moment of processing the exception (several hundred milliseconds). All subsequent exceptions (within the same task and within newly created tasks) are processed quickly (0 ms). Disabling the antivirus and disabling DEP does not change the behavior. The effect is observed in Windows 10; in Win-XP and Win-7 everything is fine.

I present the test code for verification (it is greatly simplified - just to show the effect described above).

unit DCa.Generators;

interface

type
  TNativeUIntArray = array [0 .. 65535] of Cardinal;
  PNativeUIntArray = ^TNativeUIntArray;
  TGenerator = class;
  TGeneratorProcedure = procedure( Generator: TGenerator ) of object; stdcall;

  TGenerator = class
    SP: Cardinal; 
    Stack: PNativeUIntArray; 
    constructor Create( Proc: TGeneratorProcedure; StackSize: Integer );
    destructor Destroy; override;
    procedure Enter;
    class procedure Return;
  end;

implementation

uses Windows, SysUtils;

function GetFlags: cardinal;
asm
  pushfd
  pop EAX
end;

constructor TGenerator.Create( Proc: TGeneratorProcedure; StackSize: Integer );
var StackLen: Integer;
begin
  Stack := VirtualAlloc( nil, StackSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE );
  StackLen := StackSize div SizeOf( Cardinal );
  // MoveNext
  Stack^[StackLen - 1] := 0; // _EXCEPTION_REGISTRATION.handler
  Stack^[StackLen - 2] := 0; // _EXCEPTION_REGISTRATION.prev
  Stack^[StackLen - 3] := Cardinal(Self);      // Self used by "Return" procedure
  Stack^[StackLen - 4] := Cardinal(Self);      // Self for "Proc" (parameter Generator: TGenerator)
  Stack^[StackLen - 5] := Cardinal(TMethod(Proc).Data);   // Pointer to the object that the "Proc" procedure belongs to
  Stack^[StackLen - 6] := Cardinal(@TGenerator.Return);   // When the procedure "Proc" completes, go to the "Return" procedure
  Stack^[StackLen - 7] := Cardinal(TMethod(Proc).Code);   // @Proc (EIP/RIP)
  Stack^[StackLen - 8] := GetFlags;            // save flags (EFLAGS/RFLAGS)
  Stack^[StackLen - 9] := Cardinal(@Stack^[StackLen - 2]); // FS[0] - need for exception handling
  Stack^[StackLen - 10] := Cardinal(@Stack^[StackLen]);    // FS[4]
  Stack^[StackLen - 11] := Cardinal(@Stack^[0]);           // FS[8]
  SP := Cardinal( @Stack^[StackLen - 15] ); // additional place (4 items) to push/pop EBX,EBP,ESI,EDI
  Enter(); // switch main program stack -> new created stack for "Proc" procedure
end;

destructor TGenerator.Destroy;
begin
  VirtualFree( Stack, 0, MEM_RELEASE );
end;

procedure SwitchContext;
asm
  // ECX should be =@TGenerator
  pushfd               // Save EFLAGS
  mov  eax, fs:[$00]   // Save Top ExceptionHandler
  push eax
  mov  eax, fs:[$04]   // Save Stack Top and Bottom 
  push eax
  mov  eax, fs:[$08]
  push eax
  push EBX             // Регистры общего назначения
  push EBP             // Регистры EAX,ECX,EDX сохранять
  push ESI             // не нужно, поскольку их не запрещено
  push EDI             // изменять
// Change stack pointer
  xchg ESP, dword ptr [ECX].TGenerator.&SP
// load registers from new stack
  pop EDI
  pop ESI
  pop EBP
  pop EBX
  pop eax
  mov fs:[$08], eax
  pop eax
  mov fs:[$04], eax
  pop eax
  mov fs:[$00], eax
  popfd               // load EFLAGS
end;

procedure TGenerator.Enter;
asm
  mov ECX, EAX       // ECX=Self (@TGenerator)
  jmp SwitchContext  // switch
end;

class procedure TGenerator.Return;
asm
  pop ECX            // ECX=Self (@TGenerator)
  jmp SwitchContext                        
end;

end.

Main program:

program Project1;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, DCa.Generators;

type TDummy = class
  class procedure Test(Generator: TGenerator); stdcall;
end;

class procedure TDummy.Test(Generator: TGenerator);
var
  i: Integer;
  tick: Cardinal;
begin
  for i := 1 to 3 do
    try
      Tick := GetTickCount();
      raise Exception.Create('MyExc');
    except
      Writeln('except delay = ', GetTickCount() - tick);
    end;
end;

var i: Integer;
begin
  for i := 1 to 3 do begin
    TGenerator.Create(TDummy.Test, 65536);
    readln;
  end;
end.

The typical output is:

except delay = 328
except delay = 0
except delay = 0

except delay = 0
except delay = 0
except delay = 0

except delay = 0
except delay = 0
except delay = 0

What could be the problem and how to reduce the time for processing the first exception?

(I tried to trace the code, it seems that for some reason call ntdll.NtRaiseException takes a long time to execute, but why is not clear).

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.