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

добавлено: 20 авг 16
понравилось:0
просмотров: 1521
комментов: 0

теги:

Автор: kealon(Ruslan)

Долго думал что написать про структуры данных и алгоритмы и всё никак. То времени не хватало, то писать лень
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: :желательно бы добавить протекцию стэкового буфера на его начальные адреса, что-бы хоть как-то ловить переполнение стэка
  • Комментарии




    Необходимо войти на сайт, чтобы оставлять комментарии