ObjectPascal Magic Programming
Coroutine

Light-Weightスレッドとかタスクとか、某ゲームの本にはマイクロスレッド、結構いろんな名前が付いていますが、僕はコルーチンと呼ぶ事にしています。構文として持っているのはModulaぐらいしか知りませんが(Adaを含めて最近の言語は組み込む場合は本物のスレッドを選んでいるようです)、実はHaskellの無限数列もコルーチンみたく使えることをつい先日知って感動したところです。引数の遅延評価は関数ポインタを渡すことで代替できますが、返値の遅延評価は普通の言語ではちょっと無理ですからね。

ご存じの様に、オブジェクトにすれば機能的にはコルーチンを代替できます。ローカル変数の代わりに、状態は全部オブジェクトに保持して、各メソッドは状態をひとつ進めてさっさと呼びだし元に戻る…それだけです。今更コルーチンを持ち出す必要があるのでしょうか。

ある、と思っています。変数では保存できないものがひとつあります。 現在実行しているポイント、x86で言えば(E)IPレジスタです。

状態を実行位置で表わすな、というのは、goto使いまくって自分でも管理できなくなったコードを目の当たりにした人なら経験的に体に染みついていることと思います。その代わり、状態は変数に入れます。関連する状態をひとつにまとめればオブジェクト指向です。しかし、それは解決でしょうか。やっていることは、for I := 1 to 10と書く代わりに、フィールドとしてオブジェクト内にIを持たせ、メソッドではIをひとつだけインクリメントして、一回分のループの処理だけして…。これでは、手間ばかりかかって、コード量を無駄に膨らませているだけに見えます。無論、使う側からすればこのように作られたオブジェクトは使いやすいのですが、その代わり、作る方の手間が、非OOでだらだらと、時には気ままにgotoも使ったりして書いてた頃に比べれば、半端じゃなく面倒です。どうして単なるループですら素直に書けないのでしょう。

Iteratorパターンを使って列挙するクラスを作るのと、Enum～系APIのようにコールバックして貰うのでは、作りやすさ、および、コードサイズや実行速度云々、ほとんど後者が有利です。呼ばれる側が主導権を握ればいいものを、主導権を呼びだし側に残そうとするから変なことになります。その代わり、使う側としては、一般的に前者が楽です。ただし、それは普通の制御文しか持たない言語の話。関数内関数にコールバックして貰う、もっと進めて関数をその場で作って渡す、などができる言語であれば、使うのも後者が楽かもしれません。 ──そこまでしてオブジェクト指向する価値はありますか？

コールバックにも問題はあります。呼びだし側が主導権を握れないため、呼びだし側が他に移動したい(別にgotoじゃなくてもreturnでもbreakでも例外でも)などと思っても、できません。要するに、どうしても主導権を持たない側に制限がかかります。

主導権を持っている側とはつまり、現在実行しているポイントを、自由に移動できる側。主導権が無いと、せっかく言語に用意された豊富な制御文も、自由に書けなくなります。その代わり、どこまで実行したかという状態を、変数に入れてお茶を濁さねばなりません。

現在実行しているポイントがふたつあればどうでしょう。両方が主導権を投げ合うような形で、主も従も無いコーディングができませんか？

それがコルーチンであり、マルチスレッドです。普通の関数呼出しから、主従関係を取り去ったものをコルーチン、さらに一歩進めてそれぞれ勝手な実行が可能になったものをマルチスレッド…そんな認識です。ただし、マルチスレッドにすると、実行ポイントの問題は解決というか超越というか、スレッド間でメッセージを投げたり待ち合わせをしたりする形になってしまいますので、そんな事気にしてる場合じゃ無いというか…。

コルーチンの何が楽かって、同時に実行されませんからクリティカルセクションだの何だので同期する必要が全く無いのですよ。気にすることが減るってことは、問題に集中できるってことですので、マルチスレッドにするには大袈裟過ぎると思ったらコルーチンでお茶を濁しておくのは、妥協としては上の上ではないでしょうか。 Windows3.1ですとDOS窓を除く全プロセスが(プリエンプティブ実行できないので)コルーチン状態だったりして。同期が不要というメリットに対するデメリットとしては、ひとつのコルーチンがバグると全部道連れってことですか。 Windows3.1の時代ひとつのプロセスが固まると全部固まってましたからね。マルチスレッドですと、他のスレッドが死んでも、生き残っているスレッドがそれを監視してリカバリとかできますから。

実装としては、スタックを複数用意して、CPUのスタックポインタレジスタを切り替えてやるだけです。ただしWindowsの場合は保護が色々働いてますので、コルーチン用のAPIが用意されています。 Fiberという名前ですけど。

program Coroutine;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;

type
  TReturn = procedure(Result: Pointer) of object;
  TCoroutine = procedure(Argument: Pointer; Return: TReturn);
  ICoroutine = interface
    function Execute: Pointer;
  end;
  PCoroutineImpl = ^TCoroutineImpl;
  PCoroutineVMT = ^TCoroutineVMT;
  TCoroutineVMT = record
    QueryInterface: 
      function(Self: PCoroutineImpl; const IID: TGUID; out Obj): HResult; stdcall;
    AddRef: function(Self: PCoroutineImpl): Integer; stdcall;
    Release: function(Self: PCoroutineImpl): Integer; stdcall;
    Execute: function(Self: PCoroutineImpl): Pointer;
  end;
  TCoroutineImpl = record
    VMT: PCoroutineVMT;
    RefCount: Integer;
    Coroutine: TCoroutine;
    Argument: Pointer;
    Result: Pointer;
    Fiber: Pointer;
    Caller: Pointer;
  end;

procedure Return(Self: PCoroutineImpl; Result: Pointer);
begin
  Self^.Result := Result;
  SwitchToFiber(Self^.Caller);
  if Self^.VMT = nil then Abort;
end;

procedure Fiber(Data: Pointer); stdcall;
var
  R: TReturn;
begin
  try
    TMethod(R).Code := @Return;
    TMethod(R).Data := Data;
    PCoroutineImpl(Data)^.Coroutine(PCoroutineImpl(Data)^.Argument, R);
  except
  on EAbort do ;
  end;
  repeat
    SwitchToFiber(PCoroutineImpl(Data)^.Caller);
  until False;
end;

function CoroutineQueryInterface
  (Self: PCoroutineImpl; const IID: TGUID; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE
end;

function CoroutineAddRef(Self: PCoroutineImpl): Integer; stdcall;
begin
  Inc(Self^.RefCount);
  Result := Self^.RefCount;
end;

function CoroutineRelease(Self: PCoroutineImpl): Integer; stdcall;
begin
  Dec(Self^.RefCount);
  Result := Self^.RefCount;
  if Result = 0 then
  begin
    Self^.VMT := nil;
    SwitchToFiber(Self^.Fiber);
    DeleteFiber(Self^.Fiber);
    Dispose(Self);
  end;
end;

function CoroutineExecute(Self: PCoroutineImpl): Pointer;
begin
  SwitchToFiber(Self^.Fiber);
  Result := Self^.Result;
end;

const
  CoroutineVMT: TCoroutineVMT = (
    QueryInterface: CoroutineQueryInterface;
    AddRef: CoroutineAddRef;
    Release: CoroutineRelease;
    Execute: CoroutineExecute);

function Run(Proc: TCoroutine; Argument: Pointer): ICoroutine;
var
  Impl: PCoroutineImpl;
begin
  New(Impl);
  Impl.VMT := @CoroutineVMT;
  Impl.RefCount := 0;
  Impl.Coroutine := Proc;
  Impl.Argument := Argument;
  Impl.Fiber := Pointer(CreateFiber(0, @Fiber, Impl));
  Impl.Caller := Pointer(ConvertThreadToFiber(nil));
  Result := ICoroutine(Impl);
end;

procedure KAISA_Progression(Argument: Pointer; Return: TReturn);
var
  V: Integer;
begin
  V := Integer(Argument);
  repeat
    Return(Pointer(V));
    V := V * 3;
  until False;
end;

procedure Test;
var
  P: ICoroutine;
  I: Integer;
begin
  P := Run(KAISA_Progression, Pointer(1));
  for I := 1 to 10 do
    WriteLn(Integer(P.Execute));
end;

begin
  Test;
  ReadLn
end.

DeleteFiberの呼び忘れが無いよう、interfaceにして参照カウンタで管理させます。 (interfaceをclassを使わずローレベル実装したのは、classの場合コンストラクタやらデストラクタやらでコストが…はい、貧乏性なだけです) また、後始末無しでいきなり消してしまうと、場合によっては大変なことになるかもしれませんので、消す前に一旦スイッチして、例外を投げます。これで、コルーチン側は、必要な後始末をtry..finallyを使って書けます。また、その例外を一段外側で受けることで、stringや動的配列のような自動的に管理される型の後始末も保証できます。

ついでに、Pointerで値を受け渡しってのは4バイトを超えると構造体を作らねばならず、それを避けるため、関数内関数渡しのテクニックを用いて、関数内関数をコルーチン化してみました。これはこれでありかもしれません。本当は言語がサポートしてくれるのが一番いいんでしょうね。 ↑をどう直せば↓ができるようになるかなんてのはいちいち書きませんよ。

function GetContext: Pointer; register;
asm
  mov eax, ebp
end;

procedure Test;
var
  Init, Ret: Integer;
  procedure KAISA_Progression(Argument: Pointer; Return: TReturn);
  var
    V: Integer;
  begin
    V := Init;
    repeat
      Ret := V;
      Return(nil);
      V := V * 3;
    until False;
  end;
var
  P: ICoroutine;
  I: Integer;
begin
  Init := 1;
  P := Run(TCoroutine(@KAISA_Progression), nil, GetContext);
  for I := 1 to 10 do
  begin
    P.Execute;
    WriteLn(Ret);
  end;
end;

ObjectPascal Magic Programming Coroutine

ObjectPascal Magic Programming
Coroutine