ScriptBrowserK 作者のブログ > 「Java言語で学ぶデザインパターン入門マルチスレッド編」を Delphi に移植してみた

ScriptBrowserK 作者のブログ > カテゴリ：［Delphi］

「Java言語で学ぶデザインパターン入門マルチスレッド編」を Delphi に移植してみた（2010年08月18日）

カテゴリ:［Delphi］

タグ:［］

１．概要

左の「Java言語で学ぶデザインパターン入門マルチスレッド編（結城浩著）」（著者のHP）で紹介されているデザインパターンを Delphi 2010 に移植してみました。

非常に分かりやすい本なので、マルチスレッドを使う初心者・中級者にお勧めです。

今回は、TSyncObjBase というクラスに Java のスレッド排他制御をエミュレートするためのメソッドを Delphi で実装しました。そのクラスを継承すると Java のソースを少し修正するだけで動作するので移植が楽です。

●TSyncObjBase に実装したメソッド

Notify
NotifyAll
Wait
EnterSyncronize （synchronized メソッドのエミュレート用）
ExitSyncronize （synchronized メソッドのエミュレート用）
（補足）Java で synchronized なメソッドを移植する場合に、メソッドの先頭と末尾で EnterSyncronize と ExitSyncronize を呼び出します。

Delphi 2010 以外のバージョンでは、TQueue を TList で置き換えるなどの修正を行えば動作すると思います。

排他制御に Mutex を使用していますが、critical section（こちらの方が速い）に置き換えても実装できると思います。

今回は、Guarded Suspension と Worker Thread の２つのデザインパターンを移植しました。TSyncObjBase を使用すれば、多分他のデザインパターンも簡単に移植できると思います。

改善点やバグなどがあれば、指摘して頂けると嬉しいです。

スクリーンショット

２．著作権・ライセンスについて

書籍の Java ソースの著作権は結城氏にあります。

Delphi のソースのライセンスですが、書籍の Java ソースを移植した部分は、zlib/libpng License です。私がゼロから実装した部分については自由に使って頂いてかまいません。但し、無保証です。

詳細は、各 unit 毎の先頭部分のコメントを参照してください。

３．ダウンロード

全ソースと実行ファイル：ThreadPattern.zip （396KB）

４．ソースコード（抜粋）

下記にソースのポイントとなる部分を紹介します。

TSyncObjBase のソース

const
  ciWaitIntervalMSec = 100; // 待機時に Terminated をチェックする間隔

type
  // EnterSyncronize, Wait メソッド内での Terminate による中断時に発生する例外
  // （Terminate は Java の interrupt に相当）
  EInterrupt = class(Exception);

  // EnterSyncronize, Wait メソッド内での待機中にエラーが発生した場合の例外
  EWaitFor = class(Exception);

  // synchronized でないメソッドで wait, notify, notifyAll を呼び出した場合の例外
  EIllegalMonitorState = class(Exception);

  // Java のスレッドの排他制御をエミュレートするためのオブジェクト
  TSyncObjBase = class(TObject)
  strict private
    FtlstWaitThread : TThreadList;
    FMutexLock      : TMutex;

    class threadvar FiLockCount : integer;
  private
  public
    // 下の２つは Java の synchronized メソッドをエミュレートするためのルーチン
    // メソッドの先頭と末尾で EnterSyncronize と ExitSyncronize を呼び出します。
    procedure EnterSyncronize;  // メソッド内で最初に呼び出す
    procedure ExitSyncronize;   // メソッド内で最後に呼び出す

    procedure Notify;     // Java と同等のメソッド
    procedure NotifyAll;  // Java と同等のメソッド
    procedure Wait;       // Java と同等のメソッド

    constructor Create;
    destructor Destroy; override;
  end;

implementation

type
  TDummyThread = class(TThread)
  end;

constructor TSyncObjBase.Create;
begin
  inherited;

  FMutexLock      := TMutex.Create(FALSE);
  FtlstWaitThread := TThreadList.Create;
end;

destructor TSyncObjBase.Destroy;
begin
  FreeAndNil(FMutexLock     );
  FreeAndNil(FtlstWaitThread);

  inherited;
end;

procedure TSyncObjBase.EnterSyncronize();
var
  WaitResult : TWaitResult;
begin
  while (TRUE) do begin
    WaitResult := FMutexLock.WaitFor(ciWaitIntervalMSec);
    if (TDummyThread(TThread.CurrentThread).Terminated = TRUE) then begin
      raise EInterrupt.Create('');
    end;

    if (WaitResult = wrSignaled) then
      break;

    if (WaitResult <> wrTimeout) then begin
      raise EWaitFor.Create(IntToStr(Ord(WaitResult)));
    end;
  end;

  Inc(FiLockCount);
end;

procedure TSyncObjBase.ExitSyncronize();
begin
  Assert(FiLockCount > 0);

  FMutexLock.Release();
  Dec(FiLockCount);
end;

procedure TSyncObjBase.Wait();
var
  iCntr         : integer;
  iLockCountNow : integer;
  event         : TSimpleEvent;
  WaitResult    : TWaitResult;
begin
  if (FiLockCount = 0) then
    raise EIllegalMonitorState.Create('');

  iLockCountNow := FiLockCount;

  event := TSimpleEvent.Create(FALSE);
  try
    Self.FtlstWaitThread.Add(event);

    // EnterSyncronize の多重呼び出しに対応するため、ExitSyncronize を複数実行。
    //   ※EnterSyncronize の多重呼び出しのテストは行っていません。
    for iCntr := 0 to iLockCountNow - 1 do begin
      Self.ExitSyncronize();
    end;

    while (TRUE) do begin
      WaitResult := event.WaitFor(ciWaitIntervalMSec);
      if (TDummyThread(TThread.CurrentThread).Terminated = TRUE) then begin
        Self.EnterSyncronize();
        raise EInterrupt.Create('');
      end;

      if (WaitResult = wrSignaled) then
        break;

      if (WaitResult <> wrTimeout) then begin
        raise EWaitFor.Create(IntToStr(Ord(WaitResult)));
      end;
    end;

  finally
    FreeAndNil(event);

    for iCntr := 0 to iLockCountNow - 1 do begin
      Self.EnterSyncronize();
    end;
  end;
end;

procedure TSyncObjBase.NotifyAll();
var
  lstTmp : TList;
  iCntr: Integer;
begin
  if (FiLockCount = 0) then
    raise EIllegalMonitorState.Create('');

  lstTmp := FtlstWaitThread.LockList();
  try
    for iCntr := 0 to lstTmp.Count - 1 do begin
      Assert(TObject(lstTmp[iCntr]) is TSimpleEvent);

      TSimpleEvent(lstTmp[iCntr]).SetEvent();
    end;
    lstTmp.Clear();
  finally
    FtlstWaitThread.UnlockList();
    lstTmp := nil;  // 念のため
  end;
end;

procedure TSyncObjBase.Notify();
var
  lstTmp : TList;
begin
  if (FiLockCount = 0) then
    raise EIllegalMonitorState.Create('');

  lstTmp := FtlstWaitThread.LockList();
  try
    if (lstTmp.Count > 0) then begin
      SetEvent(THandle(lstTmp[0]));
      lstTmp.Delete(0);
    end;
  finally
    FtlstWaitThread.UnlockList();
    lstTmp := nil; // 念のため
  end;
end;


end.

Guarded Suspension のソース

type
  TRequest = class(TObject)
  strict private
    FstrName : string;
  public
    constructor Create(const strName : string);
    function getName(): string;
    function AsString(): string; // ログ出力用のテキストを返す
  end;

  TRequestQueue = class(TSyncObjBase)
  strict private
    FQueue: TQueue<TRequest>;
  public
    constructor Create();
    destructor Destroy; override;

    function getRequest(): TRequest;         // synchronized メソッド
    procedure putRequest(request: TRequest); // synchronized メソッド
  end;

  TClientThread = class(TThreadBase)
  strict private
    FRequestQueue: TRequestQueue;
  private

  public
    constructor Create(RequestQueue: TRequestQueue; const strName: string);
    procedure Execute(); override;
  end;

  TServerThread = class(TThreadBase)
  strict private
    FRequestQueue: TRequestQueue;
  public
    constructor Create(RequestQueue: TRequestQueue; const strName: string);
    procedure Execute(); override;
  end;

implementation

constructor TRequestQueue.Create;
begin
  inherited;

  FQueue := TQueue<TRequest>.Create;
end;

destructor TRequestQueue.Destroy;
begin
  FreeAndNil(FQueue);

  inherited;
end;

function TRequestQueue.getRequest(): TRequest; // synchronized メソッド
begin
  EnterSyncronize();
  try
    while (FQueue.Count = 0) do begin
      wait();
    end;
    Result := FQueue.Dequeue();

  finally
    ExitSyncronize();
  end;
end;

procedure TRequestQueue.putRequest(Request: TRequest); // synchronized メソッド
begin
  EnterSyncronize();
  try
    FQueue.Enqueue(request);
    notifyAll();
  finally
    ExitSyncronize();
  end;
end;

{ TRequest }

constructor TRequest.Create(const strName: string);
begin
  inherited Create;

  FstrName := strName;
end;

function TRequest.getName: string;
begin
  Result := FstrName;
end;

function TRequest.AsString: string;
begin
  Result := '[ Request ' + FstrName + ' ]';
end;

{ TClientThread }

constructor TClientThread.Create(RequestQueue: TRequestQueue; const strName: string);
begin
  inherited Create(strName);

  FrequestQueue := requestQueue;
end;

procedure TClientThread.Execute;
var
  i       : integer;
  request : TRequest;
begin
  for i := 0 to 10 - 1 do begin
    request := TRequest.Create('No.' + IntToStr(i));

    OutputLog(Self.Name +  ' requests ' + request.AsString());

    FrequestQueue.putRequest(request);

    sleep(random(500));
  end;
end;


{ TServerThread }

constructor TServerThread.Create(RequestQueue: TRequestQueue; const strName: string);
begin
  inherited Create(strName);

  FrequestQueue := requestQueue;
end;

procedure TServerThread.Execute;
var
  i       : integer;
  request : TRequest;
begin
  for i := 0 to 10 - 1 do begin
    request := FrequestQueue.getRequest();

    OutputLog(#9#9#9#9 + Self.Name +  ' handles ' + request.AsString());

    sleep(random(1000));
  end;
end;

コメントはありません。

コメントを追加

このアイテムは閲覧専用です。コメントの投稿、投票はできません。

トラックバック

トラックバックURL : http://koz.scriptbrowserk.com/ThreadPattern.trackback

このエントリにトラックバックはありません

「Java言語で学ぶデザインパターン入門マルチスレッド編」を Delphi に移植してみた （2010年08月18日）