структуры данных.

Фильтр по тегу: co-routines

Реализация co-routines в FreePascal

Долго думал что написать про структуры данных и алгоритмы и всё никак. То времени не хватало, то писать лень
mayton тут сподвиг меня проверить можно ли сделать co-routines для современной ОС без поддержки самой ОС (Очень надеюсь она нам мешать не будет)

заготовка класса (специально сделал её похожей на TThread):
  TCoRoutine = class(TObject)
  private
    // CoRoutine создана
    FStarted: Boolean;
    // действие завершено
    FFinished: Boolean;
    // действие прервано
    FTerminated: Boolean;
    // Возможная ошибка
    FFatalException: TObject;
    // Буфер для стэка
    Stack: array of byte;
    // Значение прошлого значения стэкового регистра
    RetAddr: PByte;
  strict protected
    // переключение стэка
    procedure Switch();
  protected
    // основная процедура выполнения
    procedure Execute; virtual;
  public
    constructor Create(AStackSize: Integer = 0);
    destructor Destroy; override;
    property FatalException: TObject read FFatalException;
    property Finished: Boolean read FFinished;
    property Terminated: Boolean read FTerminated;
    // следующий расчёт
    function MoveNext(): Boolean;
    // прервать вычисления
    procedure Terminate();
  end;


конструктор иницализирующий стэк:
+ 
constructor TCoRoutine.Create(AStackSize: Integer);
begin
  inherited Create;
  if AStackSize < 1024 then AStackSize := 1024;
  // Инициализируем стэк
  SetLength(Stack, AStackSize);
  RetAddr := @Stack[0];
  inc(RetAddr, AStackSize);
  LocalSwitchInit(Self);
  FStarted := True;
end;

Переключать стэк будем следующим образом:
  • сохраняем все регистры
  • обмениваем стэковый регистр с RetAddr
  • восстанавливаем все регистры (но уже из другого стэкового блока)
  • возвращяемся к прошлой деятельности

    для 32-битного кода
    + 
    procedure LocalSwitch(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  pushad
  mov EAX, Obj
  xchg  ESP, [EAX]TCoRoutine.RetAddr
  popad
end;


    для 64-битного кода (надеюсь ничего не напутал, пока очень плохие знание по 64-битному ассемблеру, я обошёлся сохраненим регистров RBX, RDI, RSI, R12-R15, RBP за счёт предзаголовка в asm на входе на выходе совпадает с RSP (вещь скорее всего зависимая от компилятора))
    + 
    procedure LocalSwitch(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  push R12
  push R13
  push R14
  push R15
  push RBX
  push RDI
  push RSI
  xchg  RSP, [RCX]TCoRoutine.RetAddr
  pop RSI
  pop RDI
  pop RBX
  pop R15
  pop R14
  pop R13
  pop R12
  mov RBP, RSP
end;


    Иницализировать стэк для первого запуска будем делать почти аналогичным образом:
  • сохраняем все регистры
  • обмениваем стэковый регистр с RetAddr
  • передаём управление InitCoRoutine
    для 32-битного кода
    + 
    procedure LocalSwitchInit(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  pushad
  mov EAX, Obj
  xchg  ESP, [EAX]TCoRoutine.RetAddr
  and ESP, (not $F)
  push EAX
  call InitCoRoutine
  // сюда мы уже не возращаемся
end;

    для 64-битного кода
    + 
    procedure LocalSwitchInit(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  push R12
  push R13
  push R14
  push R15
  push RBX
  push RDI
  push RSI
  xchg  RSP, [RCX]TCoRoutine.RetAddr
  and RSP, (not $F)
  sub RSP, 32
  call InitCoRoutine
  // сюда мы уже не возращаемся
end;

    LocalSwitchInit и LocalSwitch имеют абсолютно одинаковые декларации и модели вызова stdcall (это важно для 32-битного режима), это позволяет использовать LocalSwitch
    для выхода из первой инициализации 
    procedure InitCoRoutine(Obj: TCoRoutine); stdcall;
begin
  LocalSwitch(Obj); // инициализация завершена, возвращаем управление в конструктор
  try
    Obj.Execute;
  except
  on E: EAbort do;
  else
    Obj.FFatalException := TObject(AcquireExceptionObject());
  end;
  Obj.FFinished := True;
  repeat
    LocalSwitch(Obj);
  until False;
end;


    Для теста я написал вот такой примитивный код
    + 
    program TestCoRoutines;

uses CoRoutines;
type
  TCoRoutineTest = class(TCoRoutine)
  private
  protected
    procedure Test(a,b : Integer);
    procedure Execute(); override;
  public
    d: Integer;
  end;

var
  R: TCoRoutineTest;

procedure TCoRoutineTest.Test(a, b: Integer);
var
  m: Integer;
begin
  if a = b then
  begin
    d := a;
    Switch();
  end else begin
    m := (a + b + 1) div 2;
    Test(a, m-1);
    Test(m, b);
  end;
end;

procedure TCoRoutineTest.Execute;
begin
  Test(1, 10);
end;

begin
  R:= TCoRoutineTest.Create();
  try
    While R.MoveNext() do begin
      Writeln(R.d);
    end;
  finally
    R.Free;
  end;
end.

    будет вполне ожидаемый примитивный вывод
    stdout
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10


    Ну и весь код модуля для самых нетерпеливых тех, кто всегда сначала смотрит завершение :
    + 
    unit CoRoutines;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;
type
  { TCoRoutine }
  TCoRoutine = class(TObject)
  private
    // CoRoutine создана
    FStarted: Boolean;
    // действие завершено
    FFinished: Boolean;
    // действие прервано
    FTerminated: Boolean;
    // Возможная ошибка
    FFatalException: TObject;
    // Буфер для стэка
    Stack: array of byte;
    // Значение прошлого значения стэкового регистра
    RetAddr: PByte;
  strict protected
    // переключение стэка
    procedure Switch();
  protected
    // основная процедура выполнения
    procedure Execute; virtual;
  public
    constructor Create(AStackSize: Integer = 0);
    destructor Destroy; override;
    property FatalException: TObject read FFatalException;
    property Finished: Boolean read FFinished;
    property Terminated: Boolean read FTerminated;
    // следующий расчёт
    function MoveNext(): Boolean;
    // прервать вычисления
    procedure Terminate();
  end;

implementation
procedure LocalSwitch(Obj: TCoRoutine); stdcall; forward;

procedure InitCoRoutine(Obj: TCoRoutine); stdcall;
begin
  LocalSwitch(Obj); // инициализация завершена, возвращаем управление в конструктор
  try
    Obj.Execute;
  except
  on E: EAbort do;
  else
    Obj.FFatalException := TObject(AcquireExceptionObject());
  end;
  Obj.FFinished := True;
  repeat
    LocalSwitch(Obj);
  until False;
end;
{$IFDEF WINDOWS}
{$IFDEF CPU32}
procedure LocalSwitchInit(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  pushad
  mov EAX, Obj
  xchg  ESP, [EAX]TCoRoutine.RetAddr
  and ESP, (not $F)
  push EAX
  call InitCoRoutine
  // сюда мы уже не возращаемся
end;

procedure LocalSwitch(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  pushad
  mov EAX, Obj
  xchg  ESP, [EAX]TCoRoutine.RetAddr
  popad
end;
{$ENDIF}
{$IFDEF CPU64}
// MSDN: https://msdn.microsoft.com/ru-ru/library/dd335933.aspx
procedure LocalSwitchInit(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  push R12
  push R13
  push R14
  push R15
  push RBX
  push RDI
  push RSI
  xchg  RSP, [RCX]TCoRoutine.RetAddr
  and RSP, (not $F)
  sub RSP, 32
  call InitCoRoutine
  // сюда мы уже не возращаемся
end;

procedure LocalSwitch(Obj: TCoRoutine); stdcall; assembler;
{$asmmode intel}
asm
  push R12
  push R13
  push R14
  push R15
  push RBX
  push RDI
  push RSI
  xchg  RSP, [RCX]TCoRoutine.RetAddr
  pop RSI
  pop RDI
  pop RBX
  pop R15
  pop R14
  pop R13
  pop R12
  mov RBP, RSP
end;
{$ENDIF}
{$ENDIF}

{ TCoRoutine }

procedure TCoRoutine.Execute;
begin

end;

procedure TCoRoutine.Switch();
begin
  try
    LocalSwitch(Self);
  finally
  end;
  if Terminated then
    Abort;
end;

constructor TCoRoutine.Create(AStackSize: Integer);
begin
  inherited Create;
  if AStackSize < 1024 then AStackSize := 1024;
  // Инициализируем стэк
  SetLength(Stack, AStackSize);
  RetAddr := @Stack[0];
  inc(RetAddr, AStackSize);
  LocalSwitchInit(Self);
  FStarted := True;
end;

destructor TCoRoutine.Destroy;
begin
  if FStarted then
    Terminate;
  FreeAndNil(FFatalException);
  inherited Destroy;
end;

function TCoRoutine.MoveNext: Boolean;
begin
  try
    LocalSwitch(Self);
  finally
    Result := not Finished;
  end;
end;

procedure TCoRoutine.Terminate;
begin
  FTerminated := True;
  try
    LocalSwitch(Self);
  finally
  end;
end;

end.


    PS: Весь код может использоваться без каких либо гарантий на правах "AS IS"
    PS2: :желательно бы добавить протекцию стэкового буфера на его начальные адреса, что-бы хоть как-то ловить переполнение стэка
    • добавлено: 20 авг 16 просмотры: 2774, комментарии: 0